Compatible with:
DOS Maximite CMM MM150 MM170 MM+ MMX Picromite ArmiteL4
Armite F4 ArmiteH7 Picomite 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