; 1DCA v2 3/26/07 ; EOD must pretty soon after or just before a page boundary to load ; "DEFINING 1DCA" $PRINT CRLF OCTAL DEFINE 1DCA "1DCA_ML" $DEFADR IFZ "1DCA_ML not found" $PRINT ELSE "*** 1DCA ***" $PRINT ;clear buffer memory so it'll work right... 76000 76177 +DO INDEX #0 PUT +LOOP DO ;until exit "1DCA_ML" $DEFADR ;push 1dca address CRLF "[D] Delay = " $PRINT DUP 7 ADD GET PNUM CRLF "[R] Rule = " $PRINT 20 31 +DO DUP INDEX ADD GET 60 ADD PCHR +LOOP DROP ;1dca address CRLF "[S] Show pattern [E] List examples [Q] Quit" $PRINT CRLF "Enter to redisplay" $PRINT CRLF DO ;until menu redisplayed "DRSEQ> " $PRINT DO ;until proper char entered CHRIN CASE = 104 ;D CRLF "Delay: " $PRINT $IN " " $CAT $VAL DUP IFZ DROP ELSE ;delay val on stack "1DCA_ML" $DEFADR 7 ADD SWAP PUT ;write delay to 1dca ml ENDIF #0 #1 ;redisplay prompt = 122 ;R CRLF "10 digit rule: " $PRINT $IN $LEN 12 SUB IFNZ "invalid" $PRINT CRLF ELSE "1DCA_ML" $DEFADR 20 ADD ;point to rule table #0 11 +DO ;write rule to 1dca ml... DUP $HEAD 60 SUB 3 AND PUT INC +LOOP DROP $DROP ;drop ptr and empty string ENDIF #0 #1 ;redisplay prompt = 123 ;S CRLF "Lines per pause: " $PRINT $IN " " $CAT $VAL DUP IFZ DROP ELSE CRLF 2 "1DCA_ML" $DEFADR EXECUTE ;randomize DO ;while any key but X pressed #1 OVER +DO #1 "1DCA_ML" $DEFADR EXECUTE ;run one generation " |" $PRINT 76001 76076 +DO INDEX GET CASE = 1 "+" = 2 "*" = 3 "#" DEFAULT " " ENDCASE $PRINT +LOOP "|" $PRINT CRLF +LOOP " --- [X] or any key --- " $PRINT CHRIN #1 40 +DO 10 PCHR 20010 PWRD +LOOP 130 SUB ;zero if X pressed WHILE CRLF DROP ;#generations ENDIF #0 #1 ;redisplay prompt = 15 ;enter #0 #1 #1 ;redisplay menu = 121 ;Q #1 #1 #1 ;quit = 105 ;E CRLF "0020123010 0012301200 0130010200 0012301100 0012130100" $PRINT CRLF "0302120100 0003201300 0113123000 0003132000 1002132000" $PRINT CRLF "0020331100 0003212000 0011232000" $PRINT CRLF #0 #1 ;redisplay prompt DEFAULT 10 PCHR 20010 PWRD #0 ;erase anything else ENDCASE UNTIL ;correct entry UNTIL ;menu redisplayed UNTIL ;user quits #0 S>SR ;reset switch reg ENDIF END ; "CREATING 1DCA_ML" $PRINT CRLF ; ; 1-D Cellular Automata for HP-IPL/OS w/CREATE ; enter #generations on stack before calling ; does not do random init if only 1 generation ; Terry Newton 8/7/02 11/25/02 12/6/02 3/7/06 ; OCTAL CREATE 1DCA_ML JSB ZSPOP,I * pop stack to get number of cycles STA NUCYC * save CLB,INB * put a 1 in B CPA 1 * is A = 1? JMP ILOOP * yes - do not init JMP START * no - init with random start C2 OCT 100 * delay, increase to slow (squares) NUCYC OCT 0 * number cycles BUF1 OCT 76000 BUFFE OCT 76077 BUFFS OCT 76076 VIEWP OCT 76030 * veiwport BUF2 OCT 76100 BUFFA OCT 0 * current buffer address BUFFC OCT 0 * current copy address RULE1 OCT 0 * rule 0012301200 OCT 0 OCT 1 OCT 2 OCT 3 OCT 0 OCT 1 OCT 2 OCT 0 OCT 0 RULEA DEF RULE1 M1 OCT 177777 RND OCT 123456 RND2 OCT 543210 * return random in A and RND GETRN NOP LDA RND RAL STA RND LDA RND2 INA STA RND2 XOR RND STA RND JMP GETRN,I RMASK OCT 3 * 0-3 * random init in BUF1 RINIT NOP LDB BUF1 RILOO JSB GETRN AND RMASK STA 1,I CPB BUFFE JMP RINIT,I INB JMP RILOO COUNT OCT 0 * cell neighborhood count UCELL NOP * update one cell in memory pointed to by BUFFA * put new state in memory pointed to by BUFFC LDA BUFFA * get current state address ADA M1 * subtract 1 LDB 0,I * get state STB COUNT * count = state (adr-1) INA LDB 0,I ADB COUNT STB COUNT * count = count + state (adr) INA LDB 0,I ADB COUNT STB COUNT * count = count + state (adr+1) * (buffc) = number at (rulea + count) LDA RULEA ADA COUNT LDB 0,I STB BUFFC,I * save new state JMP UCELL,I * return ULINE NOP * update all cells (except first and last) LDA BUF1 INA STA BUFFA LDA BUF2 INA ULOOP STA BUFFC JSB UCELL * update cell LDA BUFFA CPA BUFFS * done? JMP ULDON * yes, exit loop INA * no inc ptrs STA BUFFA LDA BUFFC INA JMP ULOOP * and loop * now copy C back to A ULDON LDA BUF1 STA BUFFA LDA BUF2 ULCPL STA BUFFC LDA BUFFC,I STA BUFFA,I LDA BUFFA CPA BUFFE * done? JMP ULINE,I * yes, exit sub INA STA BUFFA LDA BUFFC INA JMP ULCPL * T1 OCT 0 * offset counter T2 OCT 0 * word to display C1 OCT 17 * max bit = 15 START JSB RINIT * random start ILOOP JSB ULINE * loop - do one generation * show activity on lights, the point of all this * pack 16 words from the middle of the buffer into * the bits of SR, counting 0 as 0 and 1-3 as bit 1 LDA VIEWP STA BUFFA CLA SRLP STA T1 * clear counter LDA BUFFA,I * get state ISZ BUFFA * increment buffer pointer CLE * clear E SZA * skip if A zero CME * if 1-3 complement E LDA T2 * get word to display ELA * rotate E into word STA T2 * and save back LDA T1 * get count CPA C1 * done? JMP SRDON * yes, continue INA * increment count JMP SRLP * save T1 and keep looping SRDON LDA T2 * get state display word OTA 1 * write to switch register LDA C2 * get delay factor SRDE0 STA T1 * put in T1 LDA C2 * get delay factor SRDE1 STA T2 LDA T2 ADA M1 SZA JMP SRDE1 * squaring delay LDA T1 ADA M1 SZA JMP SRDE0 LDA NUCYC * get countdown ADA M1 * subtract 1 STA NUCYC * put back SZA * skip if 0 JMP ILOOP * if not 0 keep looping END ; CONSOLE