Retro computing - sliderule


Author Message
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 6546
Posted: 05:40am 06 Dec 2020      

This is 'real' retro.



You can move the slide using the left and right arrows or the cursor using up and down.
In both cases, 'shift' moves fast and 'ctrl' move real slow.

If you have a mouse, simply drag the slide or cursor.
You will have to edit line 10 to suit your mouse port (or zero if no mouse)

I need to experiment with the various blit/sprite methods to see if I can reduce the flicker.

 'TassyJim December 2020
 '
 'simple Mannheim type slide rule
 ' translated for a post on the LIberty Basic forum by tsh73
 'If you need instructions on operating slide rule, you can check
 'https://www.sliderulemuseum.com/
 '
 OPTION EXPLICIT
 OPTION DEFAULT FLOAT
 CONST mouseport = 2 ' use 0 for no mouse else 1-3 for the corresponding port
 DIM WW = MM.HRES
 DIM x0=1
 DIM x1=10
 DIM n = 1000
 DIM h0 = (x1)/n
 DIM firstXX=30
 DIM SCALE = (WW - 2*firstXX)/LOG(x1)
 
 'vertical scale positions in pixels
 CONST Tedge = 30
 CONST Lline  = Tedge + 35
 CONST Kline  = Lline + 35
 CONST ABline = Kline + 35
 CONST CDline = ABline+ 70
 CONST Sline  = CDline+ 70
 CONST Tline  = Sline + 35
 CONST Ledge  = Tline + 10
 
 DIM x,i,h,d,xx, lastxx, dd, quit, kp,sp, nudge
 DIM oldFirstXX, k, slidepos, oldpos, cursorpos, oldcursorpos
 DIM mx, my, ms, mc, mlb, oldmx, oldlmb
 CONST bg1 = RGB(255,255,128)
 CONST bg2 = RGB(WHITE)
 CONST gra = RGB(32,32,32)
 
 MODE 1,8,RGB(BLACK),moveslide
 CLS
 PAGE WRITE 1
 CLS
 IF mouseport > 0 THEN
   CONTROLLER MOUSE OPEN mouseport
   GUI CURSOR ON 1,MM.HRES/2,MM.VRES/2,RGB(RED)
 ENDIF
 BOX 10,Tedge+5,WW-10,Kline-Tedge,1,bg1,bg1
 BOX 10,Kline+5,WW-10,Sline-Kline,1,bg2,bg2
 BOX 10,Sline-30,WW-10,Ledge-Sline+35,1,bg1,bg1
 
 '=============== Draw scales ================
 'C, D scales (main) -------------------------------------
 x = x0
 i = 0
 DO WHILE i<=900
   SELECT CASE x
     CASE IS <2
       h = 1
     CASE IS <4
       h = 2
     CASE ELSE
       h = 5
   END SELECT
   xx = firstXX+LOG(x)*SCALE
   d=7
   IF i MOD 5 = 0 THEN d=d+2
   IF i MOD 10 = 0 THEN d=d+3
   IF i MOD 100 = 0 THEN d=d+4
   LINE xx,CDline,xx,CDline-d,1,gra
   LINE xx,CDline+2,xx,CDline+2+d,1,gra
   IF i MOD 100 = 0 THEN
     TEXT xx-3,CDline-27,LEFT$(STR$(x),1),,7,1,gra,bg2
     TEXT xx-3,CDline+27,LEFT$(STR$(x),1),,7,1,gra,bg2
   ELSE
     IF i MOD 10 = 0 AND x<2 THEN
       TEXT xx-7,CDline-24,"1."+RIGHT$(STR$(x-1),1),,7,1,gra,bg2
       TEXT xx-7,CDline+24,"1."+RIGHT$(STR$(x-1),1),,7,1,gra,bg2
     END IF
   END IF
   i = i+h
   x = x+h*h0
 LOOP
 lastXX=xx
 
 'Pi mark on C,D scales -------------------------------------
 xx = firstXX+LOG(ACOS(-1))*SCALE
 d=5
 dd=12
 TEXT xx-3,CDline-28,"pi",,7,1,gra,bg2
 TEXT xx-3,CDline+28,"pi",,7,1,gra,bg2
 LINE xx,CDline-dd,xx,CDline-dd-d,1,gra
 LINE xx,CDline+2+dd,xx,CDline+2+dd+d,1,gra
 '
 'L scale -------------------------------------
 n=200
 h=(lastXX-firstXX)/n
 FOR i = 0 TO n
   x=i/200
   xx=firstXX+i*h
   d=7
   IF i MOD 2 = 0 THEN d=d+2
   IF i MOD 10 = 0 THEN d=d+6
   IF i MOD 20 = 0 THEN d=d+4
   LINE xx,Lline,xx,Lline-d,1,gra
   IF i MOD 20 = 0 THEN
     TEXT xx-8,Lline-24,STR$(x,1,1),,7,1,gra,bg1 '+4*(i=200)
     '#gr "\";right$(using("#.#",x), 3 + (i=200))
   END IF
 NEXT i
 '
 'A, B scales (square) -------------------------------------
 oldFirstXX=firstXX
 FOR k=1 TO 2
   x = x0
   i = 0
   DO WHILE i<=900
     SELECT CASE x
       CASE IS <2
         h = 2
       CASE IS <5
         h = 5
       CASE ELSE
         h = 10
     END SELECT
     xx = firstXX+LOG(x)/2*SCALE
     d=7
     IF i = 50 THEN d=d+3
     IF i MOD 10 = 0 THEN d=d+2
     IF i MOD 100 = 0 THEN d=d+5
     LINE xx,ABline,xx,ABline-d,1,gra
     LINE xx,ABline+2,xx,ABline+2+d,1,gra
     IF i MOD 100 = 0 THEN
       TEXT xx-3,ABline-27,LEFT$(STR$(x),1),,7,1,gra,bg2
       TEXT xx-3,ABline+27,LEFT$(STR$(x),1),,7,1,gra,bg2
     END IF
     i = i+h
     x = x+h*h0
   LOOP
   firstXX = xx
 NEXT k
 '
 'K scale (cube) -------------------------------------
 firstXX= oldFirstXX
 FOR k=1 TO 3
   x = x0
   i = 0
   DO WHILE i<=900
     SELECT CASE x
       CASE IS <3
         h = 5
       CASE IS <6
         h = 10
       CASE ELSE
         h = 20
     END SELECT
     xx = firstXX+LOG(x)/3*SCALE
     d=7
     IF i MOD 10 = 0 THEN d=d+2
     IF i MOD 50 =0 THEN d=d+3
     IF i MOD 100 = 0 THEN d=d+5
     LINE xx,Kline,xx,Kline-d,1,gra
     IF i MOD 100 = 0 THEN
       TEXT xx-3,Kline-27,LEFT$(STR$(x),1),,7,1,gra,bg1
     END IF
     i = i+h
     x = x+h*h0
   LOOP
   firstXX = xx
 NEXT
 '
 ' S scale (sine)
 ' todo
 '
 ' T scale (tangent)
 ' todo
 '
 'labels -------------------------------------
 TEXT 15,Kline-10,"K",,7,1,gra,bg1
 TEXT 15,ABline-12,"A",,7,1,gra,bg2
 TEXT 15,ABline+5,"B",,7,1,gra,bg2
 TEXT 15,Lline-10,"L",,7,1,gra,bg1
 TEXT 15,CDline-12,"C",,7,1,gra,bg2
 TEXT 15,CDline+5,"D",,7,1,gra,bg2
 TEXT 15,Sline-10,"S",,7,1,gra,bg1
 TEXT 15,Tline-10,"T",,7,1,gra,bg1
 
 BLIT READ 1,10,Tedge,MM.HRES,ABline-Tedge,1
 BLIT READ 2,10,CDline,MM.HRES,Ledge-CDline,1
 SPRITE READ 3,10,ABline+1,MM.HRES,CDline-ABline,1
 ' make cursor as sprite
 CLS
 BOX 10,Tedge-5,50,12,1,RGB(CYAN),RGB(CYAN)
 BOX 10,Ledge-2,50,12,1,RGB(CYAN),RGB(CYAN)
 LINE 35,Tedge-10,35,Ledge+10,1,gra
 
 SPRITE READ 4,10,Tedge-5,50,Ledge-Tedge+15,1
 
 PAGE WRITE 0
 BLIT WRITE 1,10,Tedge
 BLIT WRITE 2,10,CDline
 SPRITE SHOW 3, slidepos, ABline,0
 SPRITE SHOW 4,cursorpos,Tedge-5,0
 
 TEXT MM.HRES/2,Ledge+20,"Left and right to shift slide",CM
 TEXT MM.HRES/2,Ledge+35,"Up and Down to shift cursor",CM
 TEXT MM.HRES/2,Ledge+50,"Shift for rapid, ctrl for slow",CM
 TEXT MM.HRES/2,Ledge+65,"Or drag with a mouse",CM
 TEXT MM.HRES/2,Ledge+85,"Q to quit",CM
 
 DO
   IF KEYDOWN(0) > 0 THEN
     kp = KEYDOWN(1)
     sp = KEYDOWN(7)' either shift key
     IF sp = 2 OR sp = 32 THEN nudge = 1 ELSE nudge = 0 ' single step or continuous
     IF sp = 8 OR sp = 128 THEN sp = 10 ELSE sp = 1 ' shift key for rapid movement
     SELECT CASE kp
       CASE 128
         cursorpos = MIN(cursorpos + sp,WW-1)
       CASE 129, 161
         cursorpos = MAX(cursorpos - sp,1-WW)
       CASE 131, 163
         slidepos = MIN(slidepos + sp,WW-1)
       CASE 130
         slidepos = MAX(slidepos - sp,1-WW)
       CASE 113
         quit = 1
     END SELECT
     IF nudge THEN
       DO : LOOP UNTIL KEYDOWN(0) = 0 ' single step with 'ctrl' key
     ELSE
       PAUSE 50
     ENDIF
   ENDIF
   IF mouseport THEN ' we have a mouse
     mx = MOUSE(x,mouseport)
     my = MOUSE(y,mouseport)
     GUI CURSOR mx,my
     IF MOUSE(L,2) = 1 THEN
       IF oldlmb = 0 THEN ' left button just pressed.
         oldmx = mx
         oldlmb = 1
       ENDIF
     ELSE
       oldlmb = 0
     ENDIF
     ' move the slide with the mouse
     IF oldlmb = 1 AND my > ABline AND my < CDline THEN
       slidepos = MIN(slidepos + mx-oldmx,MM.HRES-3)
       slidepos = MAX(slidepos,1-MM.HRES)
       oldmx=mx
     ENDIF
     ' move the cursor with the mouse
     IF oldlmb = 1 AND (ABS(my -Tedge)<10 OR ABS(my -Ledge)<10) THEN
       cursorpos = MIN(cursorpos + mx-oldmx,MM.HRES-3)
       cursorpos = MAX(cursorpos,1-MM.HRES)
       oldmx=mx
     ENDIF
   ENDIF
 LOOP UNTIL quit = 1
 ' tidy up things
 MODE 1,8
 CLS
 IF mouseport THEN
   CONTROLLER MOUSE CLOSE mouseport
   GUI CURSOR OFF
 ENDIF
END
 
SUB moveslide
 IF slidepos <> oldpos OR cursorpos <> oldcursorpos THEN
   SPRITE HIDE 4
   IF slidepos <> oldpos THEN SPRITE SHOW 3, slidepos, ABline, 0
   SPRITE SHOW 4, cursorpos,Tedge-5,0
   oldpos = slidepos
   oldcursorpos = cursorpos
 ENDIF
END SUB
 


You should be able to use any of the high resolution modes.

Jim
VK7JH
MMedit