5 TIMER=0
10 MODE 3 ' 320x200 pixels
20 P=160: Q=100
30 XP=144: XR=1.5*3.1415927
40 YP=56: YR=1: ZP=64
50 XF=XR/XP: YF=YP/YR: ZF=XR/ZP
60 FOR ZI=-Q TO Q-1
70 IF ZI<-ZP OR ZI>ZP GOTO 150
80 ZT=ZI*XP/ZP: ZZ=ZI
90 XL=INT(.5+SQR(XP*XP-ZT*ZT))
100 FOR XI=-XL TO XL
110 XT=SQR(XI*XI+ZT*ZT)*XF: XX=XI
120 YY=(SIN(XT)+.4*SIN(3*XT))*YF
130 GOSUB 170
140 NEXT XI
150 NEXT ZI
155 T=TIMER
157 DO:LOOP UNTIL INKEY$<>""
160 MODE 9: CLS: PRINT T/1000;" seconds": END
170 X1=XX+ZZ+P
180 Y1=199-(YY-ZZ+Q)
190 PIXEL X1,Y1,RGB(GREEN)
200 IF Y1 = 199 GOTO 220
210 LINE X1,Y1+1,X1,199,,RGB(BLACK)
220 RETURN
999 END

dim spr%(26)=(255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255)
SPRITE LOADARRAY #2,3,3,spr%(26)
SPRITE SHOW #2, 10,10,0,0

dim spr%(26)=(255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255)
SPRITE LOADARRAY #2,3,3,spr%()
SPRITE SHOW #2, 10,10,0,0

' Educ-8 Microcomputer - simulation in MMB4W 5.07.03b15
' Original hardware and concept: Copyright Jim Rowe,
'   Electronics Australia
' Adaption for MMBasic: Copyright Doug Pankhurst
' MMBasic: Copyright Geoff Graham, Peter Mather
'------------------------------------------------------
' Do some initial housekeeping/setup
Option explicit
Dim version$ = "Version: 7a Created: 22:00 21/4/22"
' now supports CMM2 - automatically set CMM2% = 1 for CMM2
Dim CMM2% = 0 ' flag to handle CMM2 specific code
If instr(1,MM.DEVICE$,"Colour") Then
 CMM2% = 1
endif

CLS
font 4,2
TEXT 20,20,"EDUC-8 - Educational Microcomputer"
'
'  setup menu
dim E8_Opts$
Dim E8_Enhance% = 0
Dim PLDIMDone% = 0
dim TLDIMDone% = 0
' simple program to add 2 numbers
'*****Note: Weird **********************************************
' E8 opcodes are defined and referred to in E8 octal (737)
' Indirect addressing and any memory reference
'   is in real octal (377)
'***************************************************************
' ADDR    DATA   Label Inst      E8 OpCode
'(octal) (octal)                 (E8 octal)
'(377)   (377)                   (737)
' 000     350   START: CLA        710  ' clear AC
' 001     050          TAD A:     110  ' 2's add A: to AC
' 002     051          TAD B:     111  ' 2's add B: to AC
' 003     152          DCA C:     312  ' deposit AC to C:, clear AC
' 004     240          JMP START: 500  ' jump START:
' 005     360          HLT        720  ' halt
' 006
' 007
' 010           A:
' 011           B:
' 012           C:
' data for program above in real octal (377)
' data &O350,&O050,&O051,&O152,&O240,&O360
'-------------
' Test Reader program
' ADDR    DATA   Label Inst      E8 OpCode
'(octal) (octal)                 (E8 octal)
'(377)   (377)                   (737)
' 000     301   START: SKF        601  ' skip on input flag data ready
' 001     240          JMP START: 500  ' jump to start
' 002     302          KRS        602  ' read input buffer (punch) to AC
' 003     304          RKF        604  ' reset input flag
' 004     240          JMP START: 500  ' jump START:
' 005     360        
' data for read punch program
data &O301,&O240,&O302,&O304,&O240,&O360
'--------------------------------------------------------------------
FONT 2
Do
 TEXT 10,140,  "EDUC-8 CONFIGURATION/SETUP MENU"
 TEXT 10,160,  "1.  Pre-load a program into Educ-8's memory"
 TEXT 10,180,  "2.  Pre-load a program into the paper tape"
 TEXT 10,200,  "3.  Select original or custom instruction set"
 Text 10,220,  "9.  Exit setup and start Educ-8"
 TEXT 10,240,  "Note: Options 2 and 3 not implimented yet"
 TEXT 10,260,  "- see notes in program for operation of Educ-8"
 TEXT 10,280,  ""
 INPUT "Select option 1 above and press Enter ",E8_Opts$
 Select Case Val(E8_Opts$)
   Case 1
     Do_ProgLoad
   Case 2
'     Do_TapeLoad  ' not yet implemented
   Case 3
'     E8_Enhance% = 1  ' not yet implemented
 End Select
 TEXT 380,280,  "   "
Loop Until Val(E8_Opts$) = 9
' these next subs are just for the menu
' - skip over to start of E8 program proper
'------------------------------------------------------
' If pre-load selected above, define main memory and/or
'   paper tape memory here, else define in main program below
'  
Sub Do_ProgLoad
 ' only dim here if we are going to pre-load
 Local i%,a%
 Dim RAM_Mem%(128)  ' longstring array of 1024 bytes used as RAM
 For i% = 0 to 5
   READ a%
   longstring setbyte Ram_Mem%(),i%,a%
 Next i%
 PLDIMDone% = 1 ' so we don't dim below
End sub

Sub Do_TapeLoad
 ' only dim here if we are going to pre-load
 Dim RP_Mem%(32)     ' longstring of 256 bytes

 TLDIMDone% = 1 ' so we don't dim below
End sub

'***************************************************************
' Enter Educ-8 program proper
'-------------------------------------------------------
' To understand the full operation of Educ-8, you should
' arrange to get a copy of the original Educ-8 project
' from Electronics Australia.
' Briefly, Educ-8 is a simulation of a subset of the
' (the serial version) DEC PDP-8S instruction set.
' The full hardware component of Educ-8 was designed
' using off the shelf 74xx IC's by Jim Rowe.
' To use:
' Click the RUN switch - this will step you through the
' program that reads in data from the Paper Tape Reader.
'
'-------------------------------------------------------
' Educ-8 registers
' - all utilize the low order 8 bits only
Dim PCReg% ' Program Counter
Dim MAReg% ' Memory address register 8 bits
Dim MBReg% ' Memory buffer register 8 bits
Dim INReg% ' Instruction register
Dim ACReg% ' Accumulator 8 bits
Dim OCReg% ' Operation code register - bits 5,6,7
Dim OAReg% ' Operand address register bits 0 - 3
DIM PGReg% ' page address reg high order 4 bits of MA
'----------------------------------------------------------------
' Memory RAM
If PLDIMDone% = 0 then ' if not done above, do now
 Dim RAM_Mem%(128)  ' longstring array of 1024 bytes used as RAM
endif
' - use LONGSTRING SETBYTE nbr%,data to store value from 0 to 255
' - use LGETBYTE nbr% to return value from longstring
'-------------------
' State flags
Dim LoadFlag%     = 0  '
Dim DepositFlag%  = 0  '
Dim ExamineFlag%  = 0  '
Dim FetchFlag%    = 0  '
Dim DeferFlag%    = 0  '
Dim ExecuteFlag%  = 0  '
Dim RunFlag%      = 0  ' Run/halt flag - 1 = run, 0 = halt
DIM SingContFlag% = 0  ' single or cont - 0=single=halt after each inst
DIM SloFstFlag%   = 0  '
DIM IAFlag%       = 0  ' direct/indirect address flag
'--------------------------------------------------------------------
' IOT device flags and buffers
' Note: The Educ-8 is the DTE, whatever device is connected is the DCE
DIm D0CTS% ' clear to send from input device 0
DIM D1CTS% '                          device 1
DIM D0IPBuf% ' input buffer device 0
DIM D1IPBuf% '              device 1
DIM D0RTS% ' ready to send to output device 0
DIM D1RTS%  '                        device 1
DIM D0OPBuf ' output buffer for device 0
DIM D1OPBuf% '                  device 1
' actual pin assignments for CMM2/Picomite - define as needed
' - need 20 digital pins
' device 0
CONST D0DSR_Pin     = 1    ' input - flag from device - ready to receive or send
CONST D0DTR_Pin     = 2    ' output - flag to device - EDUC-8 done and ready
CONST D0Data_Pin    = 3    ' input - receive port + 7 more consecutive pins
' device 1
CONST D1DSR_Pin     = 11   ' input - flag from device - ready to receive or send
CONST D1DTR_Pin     = 12   ' output - flag to device - EDUC-8 done and ready
CONST D1Data_Pin    = 13   ' input - receive port + 7 more consecutive pins
'------------------------------------------------------------------------
' Arithmetic flags
Dim CarryFlag%    = 0 ' accumulator carry flag - 1 = carry
Dim ZeroFlag%     = 0 ' accumulator zero flag - 1 = zero

' misc
Dim B4Mask% = &B1111     ' mask direct address bits 0-3
Dim B8Mask% = &B11111111 ' mask low order 8 bits
Dim B15Mask% = &B111111111111111 ' mask low order 15 bits
Dim OCMask% = &B11100000 ' mask in opcode bits 5,6,7
DIM OAMask% = &B1111     ' mask in operand address bits
DIM PGMask% = &B11110000 ' mask in Page address in MBReg
DIM opcode%
' note these bits are also used for different purposes
' in operate and IOT microinstructions

Dim DataSw% ' low order 8 bits equate to data switch 0 thru 7
Dim Sw_Reg% ' low order 15 bits equate to switches left to right

Dim i,j  'general purpose counters
'--------------------------------------
' front panel 15 switches, 0 thru 14
' data switches d0 thru d7 - 0 = off, any other value = on
Dim s7%,s6%,s5%,s4%,s3%,s2%,s1%,s0%
' control switches
Dim s8%  ' load address - mom - 0 = off, 1 = load address
Dim s9%  ' deposit - mom - 0 = off, 1 = deposit data
Dim s10% ' examine - mom - 0 = off, 1 = examine memory
Dim s11% ' run - mom - 0 = off, 1 = run
Dim s12% ' halt - mom - 0 = off, 1 = halt
Dim s13% ' single/continuous - 1 = single, 0 = continuous
Dim s14% ' slow/fast - 0 = slow, 1 = fast
Dim sw_num% ' switch number 0 thru 14, right to left
'---------------------------------------
' Static switch display shape parameters
' - x offset from top left of screen for 15 switches
'Dim sw_xtl%(14) = (20,60,100,140,180,220,260,300,420,460,500,620,660,700,740)
Dim sw_xtl%(14) = (300,260,220,180,140,100,60,20,420,460,500,620,660,700,740)
' y offset from top left of screen
Dim sw_ytl% = 220
'............
' switches - actual switch x and y co-ordinates
' on/off switches - off position
Dim xbar_onf% = 7    ' on and off bar x offset
Dim ybar_of% = 223   ' off bar y pos (absolute)
Dim w_onf_bar% = 24  ' on and off bar width
Dim h_onf_bar% = 3   ' on and off bar height
' polygon x co-ordinates  - starts top left, add per switch
Dim dsx_of%(3) = (6,32,37,1)
' polygon y co-ordinates (absolute) - starts top left
Dim dsy_of%(3) = (222,222,245,245)

' on/off switches - on position for on/off and momentary switches
Dim xbar_on% = 7    ' on bar x pos
Dim ybar_on% = 264  ' on bar y pos (abs)
' polygon x co-ordinates  - starts top left, add per switch
Dim mdsx_on%(3) = (1,37,32,6)    ' polygon x positions - starts top left
' polygon y co-ordinates (absolute) - starts top left
Dim mdsy_on%(3) = (245,245,268,268)  ' polygon x positions - starts top left

' momentary switches - off position
Dim mxbar_of% = 5
Dim mybar_of% = 245
Dim w_mbar_of% = 28
Dim h_mbar_of% = 4
' polygon x co-ordinates  - starts top left, add per switch
Dim msx_of%(5) = (1,37,34,34,4,4)
' polygon y co-ordinates  - starts top left, add per switch
Dim msy_of%(5) = (240,240,246,249,249,246)

' momentary switches on position
' - same as for on/off switches
'------------------------------
' arrays to hold static switch parameters
Dim stype%(14) = (0,0,0,0,0,0,0,0,1,1,1,1,1,0,0) ' 0=on/off, 1=mom
Dim scol(14)
' pre-define switch colours
For i = 0 to 7  ' data switches D7 thru D0
 scol(i) = rgb(130,130,150)
Next i
scol(8) = rgb(0,0,250)      ' Load
scol(9) = rgb(250,0,250)    ' Deposit
scol(10) = rgb(130,160,130) ' Examine
scol(11) = rgb(0,250,0)     ' Run
scol(12) = rgb(250,0,0)     ' Halt
scol(13) = rgb(250,150,150) ' Single/Continuous
scol(14) = rgb(150,250,250) ' Slow/Fast

' per switch variables
Dim sw_col    ' switch colour
Dim sw_type%  ' switch type - 0 = on/off, 1 = momentary
Dim sw_stat%  ' switch status - 0 = off, 1 = on (operated)
'--------------------------------------
' Paper tape reader/punch parameters
' Tape memory = max 256 bytes
If TLDIMDone% = 0 then ' may have been preset above
 Dim RP_Mem%(32)     ' longstring of 256 bytes
endif
dim Tape_Mem%(4)    ' longstring 32 bytes of tape visible
dim RPInBuf% = 0    ' buffer for punch input
Dim RPOutBuf% = 0   ' buffer for reader output
Dim RPPos% = 0      ' pointer into RP_Mem%()
Dim RPOnInit% = 1     ' so we do readytaperead just once
dim RPOffInit% = 1
DIM RPSw% = 0
Dim RPHeadByte% = 0 ' byte under read/punch head
Dim RPTrailer%
dim DTR0Flag%
'Dim ReadPunch% = 0  ' 0 = read, 1 = punch
Dim RPOnOff% = 0    ' Reader/Punch 1 = power on
'DIM RPDSR% = 0      ' reader/punch 1 = ready to read/punch
'Dim RPFault% = 0    ' 0 = good, 1 = read/punch error
'DIM RPLED% = 0      ' indicate read or punch operation
'Dim RPSpeed% = 0    ' reads/punches per sec, 0 = 2/sec, 1 = 100/sec
'
'--------------------------------------

' GUI setup
' constants for area ctrls - equate to bits(-1) in SwReg%
CONST SD7 = 8 'SwReg% bit 7
CONST SD6 = 7
CONST SD5 = 6
CONST SD4 = 5
CONST SD3 = 4
CONST SD2 = 3
CONST SD1 = 2
CONST SD0 = 1 ' SwReg% bit 0
CONST SLoad   = 9  'SwReg% bit 8
CONST SDep    = 10
CONST SExam   = 11
CONST SRun    = 12
CONST SHalt   = 13
CONST SSinCon = 14
CONST SFstSlo = 15 ' SwReg% bit 14

'--------------------------------------
' pre set some registers for initialise
PCReg% = 0 ' program counter
MAReg% = 0 ' memory addr register
MBReg% = 0 ' memory buffer register
ACReg% = 0 ' accumulator
PGReg% = 0 ' page register
INReg% = 0 ' instruction register

' preset some switch parameters
Sw_Reg% = &b000000000000000
'.........
' Start of initialise subs
INITIALISE:
Init_Display ' draw all static user interface
     ' set up all IO pins etc.
If CMM2% = 1 Then
 Init_IO   ' set up CMM2 I/O pins
Else
 Init_RdrPunch ' set up glass Reader Punch
Endif

' GUI area defines for mouse click on switches
' - must be after initialise
GUI Area SD7,20,220,38,50
GUI Area SD6,60,220,38,50
GUI Area SD5,100,220,38,50
GUI Area SD4,140,220,38,50
GUI Area SD3,180,220,38,50
GUI Area SD2,220,220,38,50
GUI Area SD1,260,220,38,50
GUI Area SD0,300,220,38,50
GUI Area SLoad,420,220,38,50
GUI Area SDep,460,220,38,50
GUI Area SExam,500,220,38,50
GUI Area SRun,620,220,38,50
GUI Area SHalt,660,220,38,50
GUI Area SSinCon,700,220,38,50
GUI Area SFstSlo,740,220,38,50
If CMM2% then
 GUI CURSOR COLOUR RGB(RED) ' only works on CMM2
Endif
GUI LED #20,"",220,382,6,RGB(red)
GUI Switch #21,"ON|OFF",50,340,50,40,RGB(Green),rgb(0,120,0)
GUI Interrupt M_ClkDn,M_ClkUp
'-----------------------------------------------------------
MAIN:
' start of state machine
Do while inkey$ = "" ' just so we can breakout cleanly
 Do While RunFlag% = 1   ' main program loop,
   ' - broken out by Halt instruction, Halt key, or Sing/Cont = Sing
   ' debug - text 0,340,"Enter run loop"
   Fetch        ' get instruction pointed to by PCReg
   If SloFstFlag% = 0 Then
     Pause 400
   Endif
   ExecuteInst  ' execute it
   If SloFstFlag% = 0 Then
     Pause 400
   Endif
   If (SingContFlag% = 0) Then
     RunFlag% = 0
   Endif
   ' debug - Text 0,340,"Thru main loop"
 LOOP

 If LoadFlag% then
   ACReg% = 0  ' for clean start
   LoadAddr
   Draw_Sw (sw_num%)
   Draw_RegLEDs (PCReg%,MAReg%,MBReg%,ACReg%,INReg%)
   ClearBit (Sw_Reg%,8)
   LoadFlag% = 0
 Endif

 If DepositFlag% then
   Deposit
   Draw_Sw (sw_num%)
   Draw_RegLEDs (PCReg%,MAReg%,MBReg%,ACReg%,INReg%)
   PCReg% = PCReg% + 1 ' now pointing to next mem location
   ClearBit (Sw_Reg%,9)
   DepositFlag% = 0

 Endif

 If ExamineFlag% then
   Examine
   Draw_Sw (sw_num%)
   Draw_RegLEDs (PCReg%,MAReg%,MBReg%,ACReg%,INReg%)
   Draw_OCLEDs (OCReg%)
   PCReg% = PCReg% + 1 ' now pointing to next mem location
   ClearBit (Sw_Reg%,10)
   ExamineFlag% = 0
 Endif
 
Loop ' End of main program loop


'debug
Text 0,360,version$ + "End program"
print
End
'**********************************************************
'Subs for handling switch non-running operations
Sub LoadAddr
 Local i%
 PCReg% = Sw_Reg% AND B8Mask%
 MAReg% = PCReg%
 MBReg% = 0
End Sub

Sub Deposit
 Local t_byte$
 MAReg% = PCReg% AND B8Mask%
 MBReg% = Sw_Reg% AND B8Mask%
 OCReg% = MBReg% AND OCMask%
 Longstring Setbyte RAM_Mem%(),MAReg%,MBReg%
End Sub

Sub Examine
 Local i%
 MAReg% = PCReg% AND B8Mask%
 MBReg% = LGETBYTE (RAM_Mem%(),MAReg%)
 INReg% = MBReg%
 OCReg% = MBReg% AND OCMask%
End Sub
'-------------------------------------------------
' Operational subs and functions
Sub Fetch ' get instruction from address pointed to by PC
 FetchFlag% = 1
 ExecuteFlag% = 0
 MAReg% = PCReg% AND B8Mask%
 PGReg% = PCReg% AND PGMask%
 INReg% = LGETBYTE (RAM_Mem%(),PCReg%)
 MBReg% = LGETBYTE (RAM_Mem%(),MAReg%)
 OCReg% = MBReg% AND OCMask% ' opcode bits 5,6,7
 opcode% = OCReg% >> 5 ' move OC to lo 3 bits
 OAReg% = MBReg% AND OAMask% ' lo order 4 bits - mem addr of operand
 PCReg% = (PCReg% + 1) AND B8Mask%
 Draw_SFlags ' state LEDs
End Sub

SUB ExecuteInst ' decode instruction and execute
'  Local opcode%
 FetchFlag% = 0
 ExecuteFlag% = 1
 If opcode% < 6 then
   IAFlag% = GetBit%(MBReg%,4) ' indirect address flag
 endif
 Select Case opcode%
 ' codes 0 thru 5 and memory reference instructions
   Case 0
     Do_AND
   Case 1
     Do_TAD
   Case 2
     Do_ISZ
   Case 3
     Do_DCA
   Case 4
     Do_JMS
   Case 5
     Do_JMP
   ' operate microinstructions  
   Case 6    ' now further decode IOT microinstructions
     Do_IOT
   ' I/O microinstructions  
   Case 7    ' now further decode operate microinstructions
print ,,,,,,,,,,,,,,,"start Do_IOT",opcode%
     Do_OPM  ' IOT microinstructionsOCReg% =
 end select
 ' update all LEDs
 Draw_RegLEDs (PCReg%,MAReg%,MBReg%,ACReg%,INReg%)
 Draw_OCLEDs (OCReg%)
 Draw_SFlags
 If SingContFlag% = 0 then ' just do 1 instruction
   RunFlag% = 0
 Endif
end sub
'------------------------------
' memory reference instructions
Sub Do_AND ' AC AND contents of direct or indirect mem location
 MAReg% = PGReg% OR OAReg% ' MAReg now 8 bit pointer to direct address
 MBReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' get data from direct address location
 If IAFlag%  = 1 then ' indirect address, get address pointed to lo order 4 bits
   MAReg% = MBReg%  ' load indirect address into MAReg
   MBReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' then get indirect data
 endif    ' direct address - just use low order 4 bits
 ACReg% = B8Mask% AND (ACReg% AND MBReg%)
 If ACReg% = 0 Then
   ZeroFlag% = 0
 Else
   ZeroFlag% = 1
 Endif
 CarryFlag% = 0
End Sub ' exit with result in AC

Sub Do_TAD ' 2's addition AC + contents of direct or indirect mem location
 MAReg% = PGReg% OR OAReg% ' MAReg now 8 bit pointer to direct address
 MBReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' get data from direct address location
 If IAFlag%  = 1 then ' indirect address, get address pointed to lo order 4 bits
   MAReg% = MBReg%  ' load indirect address into MAReg
   MBReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' then get indirect data
 endif    ' direct address - just use low order 4 bits
 ACReg% = ACReg% + MBReg%
 If (ACReg% AND &Hffffffffffffff00) <> 0 then
   CarryFlag% = 1
 Else
   CarryFlag% = 0
 Endif
END SUB  ' exit with result in AC

SUB Do_ISZ ' increment contents of direct or indirect mem location and skip if zero
 MAReg% = PGReg% OR OAReg% ' MAReg now 8 bit pointer to direct address
 MBReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' get data from direct address location
 If IAFlag% = 1 then ' indirect address, get address pointed to by lo order 4 bits
   MAReg% = MBReg%  ' load indirect address into MAReg
   MBReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' then get indirect data
 endif    ' direct address - just use low order 4 bits
 ACReg% = MBReg% ' get data from mem, inc and store back
 ACReg% = ACReg% + 1
 MBReg% = ACReg% '
 Longstring SETBYTE RAM_Mem%(),MAReg%,MBReg%
 If (B8Mask% AND ACReg%) = 0 Then
   ZeroFlag% = 0
   CarryFlag% = 1
 Else
   ZeroFlag% = 1
   PCReg% = PCReg% + 1 ' skip next instruction
   CarryFlag% = 0
 Endif
END SUB

Sub Do_DCA ' deposit AC in direct or indirect mem location and clear AC
 MAReg% = PGReg% OR OAReg% ' MAReg now 8 bit pointer to direct address
 MBReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' get data from direct address location
 If IAFlag% = 1 then ' indirect address, get address pointed to by lo order 4 bits
   MAReg% = MBReg%  ' load indirect address into MAReg
   MBReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' then get indirect data
 endif    ' direct address - just use low order 4 bits
 Longstring SETBYTE RAM_Mem%(),MAReg%,ACReg%
 ACReg% = 0
 CarryFlag% = 0
 ZeroFlag% = 0
END SUB ' exit with AC = 0

SUB Do_JMS ' jump to subroutine at direct or indirect mem location
 MAReg% = PGReg% OR OAReg% ' MAReg now 8 bit pointer to direct address
 MBReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' get indirect address
 If IAFlag% = 1 then ' indirect address, get address pointed to by lo order 4 bits
   MAReg% = MBReg%  ' load indirect address into MAReg
 endif    ' direct address - just use low order 4 bits
 Longstring SETBYTE RAM_Mem%(),MAReg%,PCReg% ' store return addr in 1st sub location
 PCReg% = MAReg% + 1
END SUB

SUB Do_JMP  ' jump to location at direct or indirect mem location
 MAReg% = PGReg% OR OAReg% ' MAReg now 8 bit pointer to direct address
 If IAFlag%  = 1 then ' indirect address, get address pointed to lo order 4 bits
   MAReg% = LGETBYTE(RAM_Mem%(),MAReg%) ' get data from indirect address
 endif    ' direct address - just use low order 4 bits
 PCReg% = MAReg%  ' target address
END SUB
' end of memory instructions
'--------------------------------
' operate microinstructions - opcodes 7xx
SUB Do_OPM ' - decodes OPM instructions
 Local i%,tmpb7%,tmpb0%
'  Local opcode%
 opcode% = MBReg% AND &B11111' get OC lo 5 bits ( the xx part)
 Select Case opcode%
   Case 0  ' NOP
     ' - do nothing - fall into next instruction
   Case 1  'IAC - inc AC by 1, result in AC
     ACReg% = ACReg% + 1
     If (ACReg% AND &Hffffffffffffff00) <> 0 then
       CarryFlag% = 1
       ACReg% = ACReg% AND B8Mask%  ' back to lo order 8 bits
     Else
       CarryFlag% = 0
     Endif    

   Case 2  ' RAL - rotate AC 1 bit left, b7 -> b0,b1-b6 <- 1 place
     tmp_b7% = GetBit%(ACReg%,7)
     ACReg% = ACReg% << 1
     If tmp_b7% = 0 then
       ClearBit(ACReg%,0)
     else
       SetBit(ACReg%,0)
     Endif
     If (ACReg% AND &Hffffffffffffff00) <> 0 then
       CarryFlag% = 1
       ACReg% = ACReg% AND B8Mask%  ' back to lo order 8 bits
     Else
       CarryFlag% = 0
     Endif    

   Case 4  ' CMA - invert all bits in AC
     ACReg% = B8Mask% AND (INV(ACReg%))
     If ACReg% = 0 then
       ZeroFlag% = 1
     Else
       ZeroFlag% = 0
     Endif    
   
   Case 5  ' CMA then IAC - comliment then increment AC - form 2s comp
     ' do CMA first
     ACReg% = B8Mask% AND (INV(ACReg%))
     If ACReg% = 0 then
       ZeroFlag% = 1
     Else
       ZeroFlag% = 0
     Endif
     ' then IAC
     ACReg% = ACReg% + 1
     If (ACReg% AND &Hffffffffffffff00) <> 0 then
       CarryFlag% = 1
       ACReg% = ACReg% AND B8Mask%  ' back to lo order 8 bits
     Else
       CarryFlag% = 0
     Endif  

   Case 8  ' CLA - clear AC to 0
     ACReg% = 0
     ZeroFlag% = 1

   Case 9  '  CLA then IAC - clear AC then add 1 - ie. set AC = 1
     ' first CLA
     ACReg% = 0
     ' then IAC
     ACReg% = ACReg% + 1
     CarryFlag% = 0
     ZeroFlag% = 0

   Case 12  ' CLA then CMA - clear AC then invert AC  - ie. set AC = -1
     ' first CLA - AC = 0
     ACReg% = 0
     ' then CMA - AC now all 1s - = -1
     ACReg% = B8Mask% AND (INV(ACReg%))
     CarryFlag% = 0
     ZeroFlag% = 0

   Case 17 ' HLT
     RunFlag% = 0
     ClearBit (Sw_Reg%,12)
     ClearBit (Sw_Reg%,11)

   Case 18  ' RAR - rotate AC 1 bit right
     tmp_b0% = GetBit%(ACReg%,0)
     ACReg% = B8Mask% AND (ACReg% >> 1)
     If tmp_b0% = 1 then
       SetBit (ACReg%,7)
     Else
       ClearBit (ACReg%,7)
     Endif

   Case 20  ' SMA - skip on minus AC
            '  - ie. if AC a neg num (bit 7 = 1), skip next inst
     If GetBit%(ACReg%,7) = 1 Then
       PCReg% = PCReg% + 1
     Endif    

   Case 24  ' SZA - skip on zero AC - ie. if AC = 0, skip next instruction
     If ACReg% = 0 then
       ZeroFlag% = 0
       PCReg% = PCReg% + 1
     endif

   Case 28  ' SZA then SMA - skip next instruction if AC is minus or zero
     If (GetBit%(ACReg%,7) = 1) OR (ACReg% = 0) Then
       PCReg% = PCReg% + 1
     Endif    
 End Select
END SUB

'******* in development *******
SUB Do_IOT ' input/output instructions - 6xx
 Local DSRFlag%,DTRFlag%,RWFlag%,Device%,DevIO%
'  Local opcode%
'  opcode% = MBReg% AND &B11111' get OC lo 5 bits ( the xx part)
 If CMM2% = 0 Then ' is MMB4W so simulate I/O
   ' DSR0Flag% set by device 0 to signify ready for E8 to send if device input
   '   or data sent from device and ready for E8 to read if device output
   ' DSR1Flag% - as above for device 1
   ' RW0Flag% - set to 1 to read data from i/p buffer
   '   or write data to o/p buffer
   ' RW1Flag% - as above for device 1
   ' RW0InBuf% - input buffer for device 0
   ' RW1InBuf% - input buffer for device 1
   ' RW0OutBuf% - output buffer for device 0
   ' RW1OutBuf% - output buffer for device 1
   ' DTR0Flag% set by E8 to device 0 to signify data sent by E8 if device input
   '   or data read by E8 if device output
   ' DTR1Flag% - as above for device 1
   ' Device% - 0 for device 1, 1 for device 1
   ' DevIO% - 0 if input, 1 if output
   Select Case opcode%
     Case 1  ' &O01 SKF - get DSR, skip if device 0 ready to receive
       ' - simulated paper tape reader
       ' - acts like, from device - OK, ready for you to send to me  DSR set
       DSR0Flag% = P_SKF0%()  ' function returns 1 if read ready
       If DSR0Flag% = 1 Then
         PCReg% = PCReg% +1
       Endif
     
     CASE 9  ' &O11 SKF - get DSR, skip if device 1 ready to receive
       ' - acts like, from device - OK, ready for you to send DSR set
       If DSR1Flag% = 1 Then
         PCReg% = PCReg% +1
       Endif
         
     CASE 17 ' &O21 SDF - get DSR, skip if device 0 ready, data sent
       '- acts like, from device - OK, got that and ready for next, DSR set
       If DSR0Flag% = 1 Then
         PCReg% = PCReg% +1
       Endif
   
     CASE 25 ' &O31 SDF - get DSR, skip if device 1 ready, data sent
       '- acts like, from device - OK, got that and ready for next, DSR set
       If DSR1Flag% = 1 Then
         PCReg% = PCReg% +1
       Endif
       
     CASE 2  ' &O02 KRS - read input buffer of device 0 into AC
       RPInBuf% = P_KRS0%()  ' function returns byte under read head
       ACReg% = RPInBuf%
         
     CASE 10 ' &O12 KRS - read input buffer of device 1 into AC
       ACReg% = RW1InBuf%
   
     CASE 18 ' &O22 LDS - write AC to output buffer of device 0
       RW0OutBuf% = ACReg%
       
     CASE 26 ' &O32 LDS - write AC to output buffer of device 1
       RW1OutBuf% = ACReg%
   
     CASE 4  ' &O04 RKF - send DTR - E8 has received i/p from device 0 OK
     ' - acts like, to device - I got that, DTR set, when you've send next, set DSR
       P_RKF0  ' simulate reader reset, advance then ready
       DTR0Flag% = 1

     CASE 12 ' &O14 RKF - send DTR - E8 has received i/p from device 1 OK
     ' - acts like, to device - I got that, DTR set, when you've send next, set DSR
       DTR1Flag% = 1

     CASE 20 ' &O24 RDF - send DTR - E8 has sent o/p to device 0
     ' acts like, to device - I've sent data, DTR set, when you're done set DSR
       DTR0Flag% = 1
   
     CASE 28 ' &O34 RDF - send DTR - E8 has sent o/p to device 1
     ' acts like, to device - I've sent data, DTR set, when you're done set DSR
       DTR1Flag% = 1

     CASE 6  ' &O06 KRB (KRS + RKF) device 0 - read input and acknowledge
       RPInBuf% = P_KRS0%()  ' simulate reader reading byte under head
       ACReg% = RPInBuf%
       P_RKF0   ' sub to send reset/advance to tape
       DTR0Flag% = 1       ' RKF

     CASE 14 ' &O16 KRB (KRS + RKF) device 1 - read input and acknowledge
       ACReg% = RW1InBuf%  ' KRS
       DTR1Flag% = 1       ' RKF
   
     CASE 22 ' &O26 LDB (LDS + RDF) device 0 - write data and acknowledge
       RPOutBuf% = ACReg%  ' LDS
       DTR0Flag% = 1        ' RDF
   
     CASE 30 ' &O36 LDB (LDS + RDF) device 1 - write data and acknowledge
       RW1OutBuf% = ACReg%  ' LDS
       DTR1Flag% = 1        ' RDF
   End select
 Else  ' real I/O for CMM2 - ensure pin selection done before running
   Select Case opcode%
     Case 1  ' &O01 SKF - skip if device 0 ready to send
     
     CASE 9  ' &O11 SKF - skip if device 1 ready to send
   
     CASE 17 ' &O21 SDF - skip if device 0 ready to rx
   
     CASE 25 ' &O31 SDF - skip if device 1 ready to rx
   
     CASE 2  ' &O02 KRS - read input buffer of device 0 into AC
   
     CASE 10 ' &O12 KRS - read input buffer of device 0 into AC
   
     CASE 18 ' &O22 LDS - write AC to output buffer of device 0
   
     CASE 26 ' &O32 LDS - write AC to output buffer of device 1
   
     CASE 4  ' &O04 RKF - send DTR - E8 has received i/p from device 0 OK
   
     CASE 12 ' &O14 RKF - send DTR - E8 has received i/p from device 1 OK
   
     CASE 20 ' &O24 RDF - send DTR - E8 has sent o/p to device 0
   
     CASE 28 ' &O34 RDF - send DTR - E8 has sent o/p to device 1

     CASE 6  ' &O06 KRB (KRS + RKF) device 0 - read input and acknowledge
   
     CASE 14 ' &O16 KRB (KRS + RKF) device 1 - read input and acknowledge
   
     CASE 22 ' &O26 LDB (LDS + RDF) device 0 - write data and acknowledge
   
     CASE 30 ' &O36 LDB (LDS + RDF) device 1 - write data and acknowledge
   
   End select
 Endif
   
END SUB
'-------------------------------------------------
' Interrupts
Sub M_ClkDn ' left button down click
 local a
 If CMM2% Then
   sw_num% = CLICK(ref)-1 ' turn ctrl number to bit number
 Else
   sw_num% = MOUSE(ref)-1 ' turn ctrl number to bit number
 Endif  
 If (sw_num% < 0) or (sw_num% > 14) then
   sw_num% = 12
 endif
 ToggleBit (Sw_Reg%,sw_num%)
 Select Case sw_num%
   CASE 14   ' Slow/FGetBit%1
     SloFstFlag% = GetBit%(Sw_Reg%,sw_num%)
   CASE 13   ' single/continuous switch
     SingContFlag% = GetBit%(Sw_Reg%,sw_num%)
   Case 12   ' Halt switch
     RunFlag% = 0
     ClearBit (Sw_Reg%,sw_num%) ' halt bit
     ClearBit (Sw_Reg%,11) ' also run bit
   Case 11   ' Run switch
     RunFlag% = GetBit%(Sw_Reg%,sw_num%)
   Case 10   ' Examine switch
     ExamineFlag% = GetBit%(Sw_Reg%,sw_num%)
   Case 9    ' Deposit switch
     DepositFlag% = GetBit%(Sw_Reg%,sw_num%)
   Case 8    ' Load switch
     LoadFlag% = GetBit%(Sw_Reg%,sw_num%)
'    CASE else
'      sw_num% = 12
 End Select
 Draw_Sw (sw_num%)
 RPSw% = MOUSE(REF)   ' Reader/Punch on/off switch
     If RPSw%  = 21 then  'CTRLVAL(#21) = 1 then
       If CTRLVAL(#21) then  '
         If RPOnInit% = 1 then ' 1 means first time so do it
           ReadyTapeRead  ' load tape ready for E8 programatic read
           RPOnInit% = 0
         endif
       else
         Clear_RdrPunch
         RPOnInit% = 1
       Endif
     endif
End Sub

Sub M_ClkUp  ' left button up
 If CMM2% = 1 Then
   sw_num% = CLICK(LASTref)-1 ' turn ctrl number to bit number
 Else
   sw_num% = MOUSE(LASTref)-1 ' turn ctrl number to bit number
 Endif  
 If (sw_num% > 7 ) and (sw_num% < 13) then
   pause 300
   ClearBit (Sw_Reg%,sw_num%)
   Draw_Sw (sw_num%)
 Endif
End Sub
'-----------------------------------------------------
' General Subroutines
'Subroutine to draw single switch defined by sw_num%
Sub Draw_Sw sw_num%
 Local sxtl%       'top left x pos of switch sw_num%
 Local w_sb% = 38 ' width of switch box
 Local h_sb% = 50 ' height of switch box
 Local sx%(3) ' array holding 4 polygon points for switch when off
 Local mx%(5) ' array holding 6 polygon points for mom sw when off
 Local mdx%(3)' array holding 4 polygon points for all switches when on
 Local x%
 Local SwBit% = &B000000000000001
 Local SwBitMsk% = &B100000000000000
 If CMM2% = 1 Then ' to get around cursor shadow problem
   GUI CURSOR OFF ' hide cursor while operating switch
 Endif
 ' set per switch parameters
 sw_type% = stype%(sw_num%)
 sw_col = scol(sw_num%)
 sw_stat% = Sw_Reg% AND (SwBit% << sw_num%)
' calculate switch x top left position based on switch number
 sxtl% = sw_xtl%(sw_num%)
' blank out switch
 box sxtl%,sw_ytl%,w_sb%,h_sb%,,rgb(black),rgb(black)
 ' now paint actual switch
 if sw_stat% = 0 then ' is in the off position
   if sw_type% = 0 then  'is an on/off style switch
     for x% = 0 to 3 ' build actual polygon points - on/off sw = off
       sx%(x%) = sw_xtl%(sw_num%) + dsx_of%(x%)
     next x%
     polygon 4,sx%(),dsy_of%(),sw_col,sw_col
     box sxtl%+xbar_onf%,ybar_of%,w_onf_bar%,h_onf_bar%,,rgb(white),rgb(white)
   else  ' is a momentary style switch, then special off position
     for x% = 0 to 5 ' build actual polygon points - mom sw = off
       mx%(x%) = sw_xtl%(sw_num%) + msx_of%(x%)
     next x%
     polygon 6,mx%(),msy_of%(),sw_col,sw_col
     box sxtl%+mxbar_of%,mybar_of%,w_mbar_of%,h_mbar_of%,,rgb(white),rgb(white)
   endif
 else ' is in the on position - same for on/off and momentary
     for x% = 0 to 3' build actual polygon points - both types = on
       mdx%(x%) = sw_xtl%(sw_num%) + mdsx_on%(x%)
     next x%
   polygon 4,mdx%(),mdsy_on%(),sw_col,sw_col
   box sxtl%+xbar_onf%,ybar_on%,w_onf_bar%,h_onf_bar%,,rgb(white),rgb(white)
 endif
 If CMM2% = 1 Then
   GUI CURSOR ON 0
   GUI CURSOR COLOUR rgb(red)
 Endif
End Sub
'---------------------------
' Draw register LEDs
Sub Draw_RegLEDs (PCReg%,MAReg%,MBReg%,ACReg%,INReg%)
 Local pc_temp%,ma_temp%,mb_temp%,ac_temp%,in_temp%
 Local x%,y%,i%
 x% = 40
 y% = 43
 pc_temp% = PCReg% AND B8Mask%
 ma_temp% = MAReg% AND B8Mask%
 mb_temp% = MBReg% AND B8Mask%
 ac_temp% = ACReg% AND B8Mask%
 in_temp% = INReg% AND B8Mask%
 For i% = 7 To 0 Step -1
   If GetBit%(pc_temp%,i%) then
     Circle x%,y%,6,1,,RGB(black),RGB(red)
   Else
     Circle x%,y%,6,1,,RGB(black),RGB(80,80,80)
   EndIf
   If GetBit%(ma_temp%,i%) then
     Circle x%,y%+30,6,1,,RGB(black),RGB(red)
   Else
     Circle x%,y%+30,6,1,,RGB(black),RGB(80,80,80)
   EndIf
   If GetBit%(mb_temp%,i%) Then
     Circle x%,y%+60,6,1,,RGB(black),RGB(red)
   Else
     Circle x%,y%+60,6,1,,RGB(black),RGB(80,80,80)
   EndIf
   If GetBit%(ac_temp%,i%) Then
     Circle x%,y%+90,6,1,,RGB(black),RGB(red)
   Else
     Circle x%,y%+90,6,1,,RGB(black),RGB(80,80,80)
   EndIf
   If GetBit%(in_temp%,i%) Then
     Circle x%,y%+120,6,1,,RGB(black),RGB(red)
   Else
     Circle x%,y%+120,6,1,,RGB(black),RGB(80,80,80)
   EndIf
   x% = x% + 40
 Next i%
End Sub
'---------------------
' Draw the opcode LEDs
Sub Draw_OCLEDs (OCReg%)
 Local oc_temp%,x%,y%
 ' high order 3 bits shifted to 3 low order bits
 oc_temp% = (OCReg% AND OCMask%) \ 32
 x% = 438
 y% = 43
 ' Memory reference instructions
 If oc_temp% = 0 then  'AND
   Circle x%,y%,6,1,,RGB(black),RGB(red)
 Else
   Circle x%,y%,6,1,,RGB(black),RGB(80,80,80)
 Endif
 If oc_temp% = 1 then  'TAD
   Circle x%,y%+30,6,1,,RGB(black),RGB(red)
 Else
   Circle x%,y%+30,6,1,,RGB(black),RGB(80,80,80)
 Endif
 If oc_temp% = 2 then  'ISZ
   Circle x%,y%+60,6,1,,RGB(black),RGB(red)
 Else
   Circle x%,y%+60,6,1,,RGB(black),RGB(80,80,80)
 Endif
 If oc_temp% = 3 then  ' DCA
   Circle x%,y%+90,6,1,,RGB(black),RGB(red)
 Else
   Circle x%,y%+90,6,1,,RGB(black),RGB(80,80,80)
 Endif
 If CarryFlag% = 1 Then  ' Carry
   Circle x%,y%+120,6,1,,RGB(black),RGB(RED)
 Else
   Circle x%,y%+120,6,1,,RGB(black),RGB(80,80,80)
 Endif  
 If oc_temp% = 5 then  ' JMP
   Circle x%+40,y%+60,6,1,,RGB(black),RGB(red)
 Else
   Circle x%+40,y%+60,6,1,,RGB(black),RGB(80,80,80)
 Endif
 If oc_temp% = 4 then  ' JMS
   Circle x%+40,y%+90,6,1,,RGB(black),RGB(red)
 Else
   Circle x%+40,y%+90,6,1,,RGB(black),RGB(80,80,80)
 Endif
 ' Operate Microinstructions - OPR
 If oc_temp% = 7 then  ' OPR
   Circle x%+40,y%,6,1,,RGB(black),RGB(red)
 Else
   Circle x%+40,y%,6,1,,RGB(black),RGB(80,80,80)
 Endif
 ' Input/Output transfer instructions - IOT
 If oc_temp% = 6 then  ' IOT
   Circle x%+40,y%+30,6,1,,RGB(black),RGB(red)
 Else
   Circle x%+40,y%+30,6,1,,RGB(black),RGB(80,80,80)
 Endif
   If ZeroFlag% = 1 Then  ' Zero
   Circle x%+40,y%+120,6,1,,RGB(black),RGB(RED)
 Else
   Circle x%+40,y%+120,6,1,,RGB(black),RGB(80,80,80)
 Endif
End Sub
'-----------------
' Draw state flags
Sub Draw_SFlags
 Local x%,y%
 x% = 718
 y% = 43
 ' Operational state flags
 If RunFlag% = 1 then
   Circle x%,y%,6,1,,RGB(black),RGB(red)
 Else
   Circle x%,y%,6,1,,RGB(black),RGB(80,80,80)
 Endif
 If FetchFlag% = 1 then
   Circle x%,y%+30,6,1,,RGB(black),RGB(red)
 Else
   Circle x%,y%+30,6,1,,RGB(black),RGB(80,80,80)
 Endif
 If DeferFlag% = 1 then
   Circle x%,y%+60,6,1,,RGB(black),RGB(red)
 Else
   Circle x%,y%+60,6,1,,RGB(black),RGB(80,80,80)
 Endif
 If ExecuteFlag% = 1 then
   Circle x%,y%+90,6,1,,RGB(black),RGB(red)
 Else
   Circle x%,y%+90,6,1,,RGB(black),RGB(80,80,80)
 Endif
End Sub
'-----------------------------------------------
' Misc subs and functions
' Bit manipulation routines
Function GetBit%  (arg1%,arg2%)
 Local reg%,bitnum%,resultbit%
 reg% = arg1%
 bitnum% = arg2%
 resultbit% = reg% AND (&B1 << bitnum%)
 If resultbit% <> 0 then
   GetBit% = 1
 Else
   GetBit% = 0
 Endif
End Function

Sub SetBit (arg1%,arg2%)
 Local reg%,bitnum%,bitmask%
 reg% = arg1%
 bitnum% = arg2%
 arg1% = reg% OR (&B1 << bitnum%)
End Sub

Sub ClearBit (arg1%,arg2%)
 Local reg%,bitnum%
 reg% = arg1%
 bitnum% = arg2%
 reg% = reg% AND (B15Mask% AND (INV(&b1 << bitnum%)))
 arg1% = reg%
End Sub

Sub ToggleBit (arg1%,arg2%)
 Local reg%,bitnum%,tbit%
 reg% = arg1%
 bitnum% = arg2%
 tbit% = GetBit% (reg%,bitnum%)
 If tbit% = 0 then
    reg% = reg% OR (&B1 << bitnum%)
 Else
   reg% = reg% AND (B15Mask% AND (INV(&B1 << bitnum%)))
 Endif
 arg1% = reg%
End Sub
'-------------------------------------------------
' Initialise Subroutines - just called once at startup
'  but safer here like this.
Sub Init_IO ' configure pins etc for IO
'  Local i%
'  If CMM2 = 1 Then
   ' device 0
'    CONST Dev0DSR  = 0 ' pin to receive device ready
'    CONST Dev0DTR  = 1 ' to to signal E8 done and ready
'    CONST Dev0Data = 2 ' number of starting pin for port command
'                       ' - need 7 more consecutive pins
'    Dim D0DSRFlag%  ' input from dev signalling previous done/ready
'    DIM D0DTRFlag%  ' output to device signalling E8 done, get ready for next
'    Setpin Dev0DSR,DIN  ' to E8, (dev) I'm ready
'    Setpin Dev0DTR,DOUT ' from E8, I'm done, get ready
'    ' device 1
'    CONST Dev1DSR  = 10 ' pin to receive device ready
'    CONST Dev1DTR  = 11 ' to to signal E8 done and ready
'    CONST Dev1Data = 12 ' number of starting pin for port command
'                       ' - need 7 more consecutive pins
'    Dim D1DSRFlag%  ' input from dev signalling previous done/ready
'    DIM D1DTRFlag%  ' output to device signalling E8 done, get ready for next
'    Setpin Dev1DSR,DIN  ' to E8, (dev) I'm ready
'    Setpin Dev1DTR,DOUT ' from E8, I'm done, get ready
'  Endif
End Sub

' Initialise display - only called once at startup
'  but safer here and uses local variables
Sub Init_Display
 Local i,j,x,d 'counting variables
 Local SwBitMsk%
 CLS
 Colour RGB(black),RGB(220,210,210)
 RBox 0,0,799,300,,RGB(white),RGB(220,210,210) ' face
 Text 20,0,"EA EDUC-8+ MICROCOMPUTER",,4,2
 Box  20,30,318,150,,RGB(80,80,80),RGB(80,80,80)
 Font 1
 Text 342,38,"PC"
 Text 342,68,"MA"
 Text 342,98,"MB"
 Text 342,128,"AC"
 text 342,158,"IN"
 Box  420,30,80,150,,RGB(80,80,80),RGB(80,80,80)
 Text 390,38,"AND"
 Text 390,68,"TAD"
 Text 390,98,"ISZ"
 Text 390,128,"DCA"
 TEXT 376,158,"CARRY"
 Text 503,38,"OPR"
 Text 503,68,"IOT"
 Text 503,98,"JMP"
 Text 503,128,"JMS"
 TEXT 503,158,"ZERO"
 Box  700,30,80,150,,RGB(80,80,80),RGB(80,80,80)
 Text 670,38,"RUN"
 Text 656,68,"FETCH"
 Text 656,98,"DEFER"
 Text 663,128,"EXEC"
 ' now switch labels
 Text 422,193,"LOAD"
'  Text 422,206,"ADDR"
 Text 468,193,"DEP"
 Text 502,193,"EXAM"
 Text 626,193,"RUN"
 Text 666,193,"HALT"
 Text 706,193,"SING"
 Text 746,193,"SLOW"
 Text 706,206,"CONT"
 Text 746,206,"FAST"
 ' draw bit numbers
 x = 35
 For d = 7 To 0 Step -1
   Text x,192,Str$(d)
     x = x + 40
 Next d
 ' draw opcode lines
 Line 20,212,137,212,4,RGB(black)
 Line 140,212,217,212,4,RGB(black)  
 Line 220,212,338,212,4,RGB(black)
 'draw momentary action indicators
 Triangle 421,206,457,206,439,216,RGB(black),RGB(black)
 Triangle 461,206,497,206,479,216,RGB(black),RGB(black)
 Triangle 501,206,536,206,518,216,RGB(black),RGB(black)
 Triangle 620,206,656,206,638,216,RGB(black),RGB(black)
 Triangle 661,206,694,206,677,216,RGB(black),RGB(black)
 ' draw switches
 Sw_Reg% = Sw_Reg% AND B15Mask%

 For sw_num% = 0 to 14
   Draw_Sw sw_num%
 Next sw_num%
 ' draw LEDs
 Draw_RegLEDs (PCReg%,MAReg%,MBReg%,ACReg%)
 Draw_OCLEDs (OCReg%)
 Draw_SFlags
End Sub
'-------------------------------------------------
'Reader Punch routines
Sub Init_RdrPunch
 Local i%,x%
 Local ptx%(5) = (0,390,440,390,0,50)
 Local pty%(5) = (400,400,450,500,500,450)
 RBox 20,305,400,220,,RGB(WHITE),RGB(220,210,210)
 TEXT 32,306,"Paper Tape Reader/Punch",,1,2
 Polygon 6,ptx%(),pty%(),rgb(White),rgb(200,200,210)
 ' draw sprocket holes
 For x% = 67 to 377 step 10
   Box x%,458,6,4,,RGB(black),rgb(WHITE)
 next x%
 ' draw read/punch head
 Box 214,396,12,110,2,rgb(blue),-1 'rgb(210,210,220)
 ' switch and read/punch head
 'debug - load some data into tape for testing
 for x% = 0 to 255
   longstring setbyte RP_Mem%(),x%,x%
 next x%
 RPOnInit% = 1
'  RPOffInit% = 0
end sub

FUNCTION P_SKF0%() ' pseudo SKF dev 0 - test if reader ready
 If CTRLVAL (#21) = 1 Then ' will
   P_SKF0% = 1
 Else
   P_SKF0% = 0
 endif
end FUNCTION

FUNCTION P_KRS0%()
 ReadTape
 P_KRS0% = RPHeadByte%
end FUNCTION

SUB P_RKF0
 AdvanceTape
End sub

FUNCTION P_KRB0%() ' P_KRS0% plus P_RKF0
 ReadTape
 P_KRB0% = RPHeadByte%
 AdvanceTape
End FUNCTION

sub Clear_RdrPunch ' on power off
 Local x%
' clear tape ready for advance to start bit
 BOX 51,401,339,98,,rgb(200,200,210),rgb(200,200,210)
 ' draw sprocket holes
 For x% = 67 to 377 step 10
   Box x%,458,6,4,,RGB(black),rgb(WHITE)
 next x%
 ' draw read/punch head
 Box 214,396,12,110,2,rgb(blue),-1
 For x% = 0 to 31
   Longstring Setbyte Tape_Mem%(),x%,0
 Next x%
'  RPOffInit% = 0 ' done the clear, so skip until new OFF
end sub

sub ReadyTapeRead ' called once on power on/of Reader/Punch
' load and read(advance) tape until 1st location of tape mem
'   is under the read head
' - this will be the first byte of the RP_Mem% array (first byte of tape)
 Local i%,x%,y%,z%
 RPPos% = 0
 '*** possibly offer loading tape from file here
 ' clear tape ready for advance to start bit
 Clear_RdrPunch
 ' start by loading visible tape from tape memory
 ' read first 18 bytes of tape to position first byte under tape read head
 For y% = 0 to 15
   Longstring Setbyte Tape_Mem%(),0,LGetByte (RP_Mem%(),RPPos%)
   ShowTape
   ' read byte at read head and shuffle forward
   For x% = 31 to 1 step -1
     Longstring Setbyte Tape_Mem%(),x%,LGetByte (Tape_Mem%(),x%-1)
   Next x%
   Inc RPPos%
 next y%
 ' tape now sitting with first actual tape position
 '   under tape reader head
 ' exit with RPPos% pointing to 17th location on tape but
 '   with 1st location under tape read head
end sub

Sub ReadTape  ' KRS - read byte under head
 RPHeadByte% = LGetByte (Tape_Mem%(),15)
end sub

Sub AdvanceTape ' RKF  - advance tape 1 position, set ready
 ' enter with RPPos% pointing to location on rp mem
 '   and byte to read on tape under the read head
 ' start by loading next location on tape from tape display memory
 Local x%
 if RPPos% < 256 Then ' copy from rp mem into tape display mem
   Longstring Setbyte Tape_Mem%(),0,LGetByte (RP_Mem%(),RPPos%)
   RPTrailer% = 32
 else ' in trailer to move last tape position under read head
   Longstring Setbyte Tape_Mem%(),0,0
   RPTrailer% = RPTrailer% - 1
 endif
 ' shuffle tape display forward
 For x% = 31 to 1 step -1
   Longstring Setbyte Tape_Mem%(),x%,LGetByte (Tape_Mem%(),x%-1)
 Next x%
 ShowTape
 If RPTrailer% = 0 then ' we got to end of tape
   RPOnOff% = 0    ' turn tape off
   Ctrlval(#21) = 0
 endif
 INC RPPos% ' point to next position on tape
 ctrlval(#20) = 1
 pause 500
 ctrlval(#20) = 0
End Sub

sub ShowTape
 local x%,y%,BitNum%
 Local TapeByte%,TapePos%
 TapePos% = 0
 Do While TapePos% < 32
   TapeByte% = LGetByte (Tape_Mem%(),TapePos%)
   TapePos% = TapePos% + 1
   x% = 60 + (TapePos% * 10)
   BitNum% = 0
   for y% = 410 to 450 step 10
     if Getbit%(TapeByte%,BitNum%) = 1 then
       If TapePos% = 16 then
         circle x%,y%,3,,,rgb(red),rgb(red)
       else
         circle x%,y%,3,,,rgb(white),rgb(white)
       endif
     else
       Circle x%,y%,3,,,rgb(190,190,200),rgb(190,190,200)
     endif
     BitNum% = BitNum% + 1
   next y%
   BitNum% = 5
   for y% = 470 to 490 step 10
     if Getbit%(TapeByte%,BitNum%) = 1 then
       If TapePos% = 16 then
         circle x%,y%,3,,,rgb(red),rgb(red)
       else
         circle x%,y%,3,,,rgb(white),rgb(white)
       endif
     else
       Circle x%,y%,3,,,rgb(190,190,200),rgb(190,190,200)
     endif
     BitNum% = BitNum% + 1
   next y%
 LOOP
 pause 100
end sub


' End of initialise subroutines
'-------------------------------------------------------
'End


a=4: b=4
testsub((a),b)
print a,b
sub testsub(x,y)
x=x+1: y=y+1
end sub

4     5