CMM2 sliderule

Compatible with:
DOS Maximite CMM MM150 MM170 MM+ MMX Picromite ArmiteL4 Armite F4 ArmiteH7 CMM2

Description:
This BAS program brings back memories of pre-calculator university days.
You need to edit the mouse_port to match your installation.

 

 'TassyJim December 2020, January 2021
 '
 '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
 DIM INTEGER mouse_port = 0 ' use -1 for no mouse else 0-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)
 CLS
 PAGE WRITE 2
 CLS
 IF mouse_port >= 0 THEN
   CONTROLLER MOUSE OPEN mouse_port
   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,2
 BLIT READ 2,10,CDline,MM.HRES,Ledge-CDline,2
 SPRITE READ 3,10,ABline+1,MM.HRES,CDline-ABline,2
 ' 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,2
 
 PAGE WRITE 1
 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
 TEXT MM.HRES - 40,5,"QUIT",LT,1,1,RGB(RED),RGB(WHITE)
 PAGE COPY 1 TO 0 ,b
 
 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-3)
       CASE 129, 161
         cursorpos = MAX(cursorpos - sp,1-WW)
       CASE 131, 163
         slidepos = MIN(slidepos + sp,WW-3)
       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
     ENDIF
   ENDIF
   IF mouse_port >= 0 THEN ' we have a mouse
     mx = MOUSE(x,mouse_port)
     my = MOUSE(y,mouse_port)
     GUI CURSOR mx,my
     IF MOUSE(L,mouse_port) = 1 THEN
       IF oldlmb = 0 THEN ' left button just pressed.
         IF MOUSE(x,mouse_port)> MM.HRES-40 AND MOUSE(y,mouse_port)<18 THEN quit = 1
         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,WW-3)
       slidepos = MAX(slidepos,1-WW)
       oldmx=mx
     ENDIF
     ' move the cursor with the mouse
     IF oldlmb = 1 AND (ABS(my -Tedge)<25 OR ABS(my -Ledge)<25) THEN
       cursorpos = MIN(cursorpos + mx-oldmx,WW-3)
       cursorpos = MAX(cursorpos,1-WW)
       oldmx=mx
     ENDIF
   ENDIF
   PAUSE 10
   moveslide
 LOOP UNTIL quit = 1
 
 ' tidy up things
 CLS
 PAGE WRITE 0
 MODE 1,8
 CLS
 IF mouse_port >= 0 THEN
   CONTROLLER MOUSE CLOSE mouse_port
   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
   PAGE COPY 1 TO 0 ,b
 ENDIF
END SUB
 


 

Last edited: 08 February, 2021