Retro computing - sliderule
| Author | Message | ||||
TassyJim![]() Guru Joined: 07/08/2011 Location: AustraliaPosts: 6546 |
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 |
||||