OPT A-,M-,O+,OW-,P+,I+,O3- INCLUDE "macros/g_generalmacs.i" INCLUDE "macros/g_libmacs.i" INCLUDE "macros/g_execmacs.i" INCLUDE "macros/g_dosmacs.i" INCLUDE "cyc.ver" INCEQUS INCLIB resource INCLIB string INCLIB compute XREF ErrorStr XREF ErrorStrSize DefaultWidth = 320 DefaultDepth = 14 MinPushDown = 82 MaxMinLace = 300 MaxMaxHeight = 600 D16Offset = (640*MaxMaxHeight/8)/2 INITSYS CLICON,WBCON, BRA CodeStart ; Build the cyclic color table Saturation = 12 ; S = 8,10,12,14 or 16 Brightness = -2 ; |B| <= (16-S)/2 ColTabWords = (Saturation-1)*6 DOEDGE MACRO REPT Saturation-1 DC.W red<<8+grn<<4+blu red SET red+redcnt grn SET grn+grncnt blu SET blu+blucnt ENDR ENDM HOOKIT MACRO nwrdcnt SET -grncnt grncnt SET -blucnt blucnt SET -redcnt redcnt SET nwrdcnt ENDM red SET $F-(16-Saturation)/2 grn SET $0+(16-Saturation)/2 blu SET $0+(16-Saturation)/2 redcnt SET 0 grncnt SET 1 blucnt SET 0 CycColTab: DOEDGE HOOKIT DOEDGE HOOKIT DOEDGE HOOKIT DOEDGE HOOKIT DOEDGE HOOKIT DOEDGE HOOKIT ; Space for a few internal subs ; InDeci: ; This sub fetches a decimal number from the console ; I : none ; O : D0.L = Number InDeci: XBSR StdReadStr XBRA GetDecVal ; UpLine ; This sub moves the cursor position to the start of the previous ; line and clears it. ; I : none ; O : none ; No regs modified UpLine: CONTEXT <$B,$D,$9B,'1K'> RTS ; DropScreen: ; This sub moves the screen down in order to show the console ; window. ; I : none ; O : none GBYTE Dropped DropScreen: TST.B Dropped(GP) BNE.S NoNeedToDrop MOVE.W Push(GP),D1 BEQ.S NoNeedToDrop MOVE.L ScreenBase(GP),A0 MOVE.L #0,D0 EXT.L D1 CALL intuition,MoveScreen ST Dropped(GP) NoNeedToDrop: RTS ; PopScreen: ; This sub moves the screen back up, ; I : none ; O : none PopScreen: MOVE.W Push(GP),D1 BEQ.S NoNeedToPop MOVE.L ScreenBase(GP),A0 MOVE.L #0,D0 EXT.L D1 NEG.L D1 CALL intuition,MoveScreen SF Dropped(GP) NoNeedToPop: RTS ;----------------------------------------- ;To start with, set the return code to 10. ;----------------------------------------- CodeStart: MOVEQ #10,D0 MOVE.L D0,ReturnCode(GP) ; Open libraries OPENRLB intuition,ResourceErrorExit OPENRLB graphics,ResourceErrorExit ; Interpret the NormalDisplayColumns graphics base value LIBBASE graphics,A6 * The width of the screen is fixed to either 320 or 640, the height * of the screen may vary within a certain degree in order to accommodate * PAL/NTSC differences and perhaps 1.4 preferences overscan settings. * The reason for the fixed screen widths is that it being fixed allows * for a significant speedup in the display routine. GWORD MaxHeight GWORD MaxNoLace MOVE.W gb_NormalDisplayRows(A6),D0 CMP.W #MaxMinLace,D0 BHS.S DoNotDoubleHeight LSL.W #1,D0 DoNotDoubleHeight: CMP.W #MaxMaxHeight,D0 BLS.S DoNotLimitHeight MOVE.W #MaxMaxHeight,D0 DoNotLimitHeight: MOVE.W D0,MaxHeight(GP) LSR.W #1,D0 MOVE.W D0,MaxNoLace(GP) ; Show version number, last assembly date and startup bla Restart: CONTEXT DC.B 12,'V' VERNUM DC.B ', ' CDATE DC.B ', Programmed by A.J.Brouwer',10 DC.B 'Height: 16-',0 EVEN PRDEC.W MaxHeight(GP) CONTEXT DC.B ', Width: 24-640, it will be',10 DC.B 'set to the nearest multiple of 8.',10 DC.B 'Depth : 2-31 , Seed : Any number > 0',10,10,10,0 EVEN ; Check how user wants settings, if at all. QueryUser: BSR UpLine CONTEXT <'Set [C]ustom, [D]efaults or [Q]uit ?'> XBSR StdReadStr MOVE.B (A0),D0 AND.B #$DF,D0 CMP.B #'Q',D0 BEQ Exit CMP.B #'C',D0 BEQ.S SetCustomSettings CMP.B #'D',D0 BNE.S QueryUser MOVE.W #DefaultWidth,Width(GP) MOVE.W MaxNoLace(GP),Height(GP) MOVE.W #DefaultDepth,Depth(GP) BRA AskForSeed ; Ask the user for the width SetCustomSettings: GWORD Width RetryWidthInput: BSR UpLine CONTEXT <'Enter width : '> BSR InDeci TST.L D0 BEQ Restart ADDQ.L #4,D0 AND.B #$F8,D0 CMP.L #640,D0 BHI RetryWidthInput CMP.W #24,D0 BLO RetryWidthInput MOVE.W D0,Width(GP) ; Ask the user for the height GWORD Height RetryHeightInput: BSR UpLine CONTEXT <'Enter height : '> BSR InDeci MOVE.W MaxHeight(GP),D1 EXT.L D1 CMP.L D1,D0 BHI RetryHeightInput MOVE.W D0,Height(GP) BEQ Restart CMP.W #16,D0 BLO RetryHeightInput ; Ask the user for the depth GWORD Depth RetryDepthInput: BSR UpLine CONTEXT <'Enter depth : '> BSR InDeci CMP.L #31,D0 BHI RetryDepthInput MOVE.W D0,Depth(GP) BEQ Restart CMP.W #2,D0 BLO RetryDepthInput CMP.W #320,Width(GP) BLS.S DepthOK CMP.W #15,D0 BLS.S DepthOK CONTEXT <'Width requires Hires, Hires can display',10> CONTEXT <'upto 16 colours. Choose Depth<16 RETURN'> BSR InDeci BSR UpLine BSR UpLine BRA RetryDepthInput DepthOK: ; Ask the user to seed the randomizer AskForSeed: GLONG Seed BSR UpLine CONTEXT <'Please enter seed value : '> BSR InDeci MOVE.L D0,Seed(GP) BEQ Restart ; Show the settings that will be used BSR UpLine CONTEXT <'Width:'> PRDEC.W Width(GP) CONTEXT <' Height:'> PRDEC.W Height(GP) CONTEXT <' Depth:'> PRDEC.W Depth(GP) CONTEXT <' Seed:'> PRDEC.L Seed(GP) CONTEXT <10> ; Initialize the newscreen structure NS EQUR A2 GSTRUC NewScreen,ns_SIZEOF LEA NewScreen(GP),NS MOVE.L A2,A0 MOVEQ #ns_SIZEOF-1,D0 ClrNewScrStr: CLR.B (A0)+ DBRA D0,ClrNewScrStr MOVE.W #CUSTOMSCREEN,ns_Type(NS) ; Set the position of the top edge of the screen GWORD Push CLR.W Push(GP) CLR.W ns_TopEdge(NS) MOVE.W Height(GP),D0 CMP.W MaxNoLace(GP),D0 BLS.S NoInterlace SUB.W MaxHeight(GP),D0 NEG.W D0 MOVE.W #2*MinPushDown,D1 CMP.W D1,D0 BGT.S SetScreenTop BRA.S SetPush NoInterlace: SUB.W MaxNoLace(GP),D0 NEG.W D0 MOVEQ #MinPushDown,D1 CMP.W D1,D0 BGT.S SetScreenTop SetPush: MOVE.W D1,Push(GP) MOVEQ #0,D0 SetScreenTop: MOVE.W D0,ns_TopEdge(NS) ; Set screen width and resolution MOVE.W #320,D0 CMP.W Width(GP),D0 BHS.S SetScrWidth ADD.W D0,D0 OR.W #V_HIRES,ns_ViewModes(NS) SetScrWidth: MOVE.W D0,ActScrWidth(GP) MOVE.W D0,ns_Width(NS) ; Set screen height and lace MOVE.W Height(GP),D0 CMP.W MaxNoLace(GP),D0 BLS.S NoNeedForLace OR.W #V_LACE,ns_ViewModes(NS) NoNeedForLace: MOVE.W D0,ns_Height(NS) ; Set the number of bitplanes GWORD ActScrDepth MOVE.W Depth(GP),D0 MOVEQ #0,D1 ComputePlaneNum: BTST D1,D0 BEQ.S NoBitSoNoSet MOVE.W D1,ns_Depth(NS) ADDQ.W #1,ns_Depth(NS) NoBitSoNoSet: ADDQ.L #1,D1 CMP.W #10,D1 BNE ComputePlaneNum MOVE.W ns_Depth(NS),ActScrDepth(GP) ; Set potential mouse pointer colours CLR.W ColourMap+16*2(GP) MOVE.W #$F22,ColourMap+17*2(GP) CLR.W ColourMap+18*2(GP) MOVE.W #$FDB,ColourMap+19*2(GP) ; Compute the actual color table GSTRUC ColourMap,32*2 BRA.S JumpOverTable WeirdCountTab: DC.B 2*%00001,2*%00011,2*%00010 DC.B 2*%00110,2*%00111,2*%00101,2*%00100 DC.B 2*%01100,2*%01101,2*%01111,2*%01110 DC.B 2*%01010,2*%01011,2*%01001,2*%01000 DC.B 2*%11000,2*%11001,2*%11011,2*%11010 DC.B 2*%11110,2*%11111,2*%11101,2*%11100 DC.B 2*%10100,2*%10101,2*%10111,2*%10110 DC.B 2*%10010,2*%10011,2*%10001,2*%10000 EVEN JumpOverTable: LEA CycColTab(PC),A0 LEA ColourMap(GP),A1 MOVEQ #0,D0 SetEachColourWord: MOVE.W D0,D1 MULU #2*ColTabWords,D1 DIVU Depth(GP),D1 ADDQ.W #1,D1 BCLR #0,D1 MOVE.W 0(A0,D1.W),-(SP) MOVE.B WeirdCountTab(PC,D0.W),D1 MOVE.W (SP)+,0(A1,D1.W) ADDQ.W #1,D0 CMP.W Depth(GP),D0 BNE SetEachColourWord ; Execute the actual cyclic space evolution routine. BSR EvolveTheCyclicSpace BRA Restart ; The cleanup code Exit: CLR.L ReturnCode(GP) ResourceErrorExit: MOVE.L ErrorStrSize(GP),D0 BEQ.S NoErrorStringSet LEA ErrorStr(A5),A0 XBSR StdWrite CONTEXT <', [ENTER]'> BSR InDeci NoErrorStringSet: RTS ;------------------------------------------------------- ; Building blocks for the cyclic space evolution routine ;------------------------------------------------------- GLONG Plane1 GLONG Plane2 GLONG Plane3 GLONG Plane4 GLONG Plane5 GWORD InitialSOLOffset GWORD InitialEOLOffset GLONG CntrBufWrap GLONG BitBufWrap GWORD MiddleLines INITVARS MACRO ; Initialize the plane pointers used for the full pixel redraw MOVE.L ScreenBase(GP),A0 LEA sc_BitMap+bm_Planes(A0),A0 CLR.L Plane3(GP) CLR.L Plane4(GP) CLR.L Plane5(GP) MOVE.L #D16Offset,D0 MOVE.L (A0)+,Plane1(GP) ADD.L D0,Plane1(GP) MOVE.L (A0)+,Plane2(GP) ADD.L D0,Plane2(GP) CMP.W #4,Depth(GP) BLO.S .PlanesSet MOVE.L (A0)+,Plane3(GP) ADD.L D0,Plane3(GP) CMP.W #8,Depth(GP) BLO.S .PlanesSet MOVE.L (A0)+,Plane4(GP) ADD.L D0,Plane4(GP) CMP.W #16,Depth(GP) BLO.S .PlanesSet MOVE.L (A0),Plane5(GP) ADD.L D0,Plane5(GP) .PlanesSet: ; Set the initial start- and end-of-line offsets MOVE.W ActScrWidth(GP),D0 SUB.W Width(GP),D0 LSR.W #4,D0 MOVE.W Width(GP),D1 LSR.W #3,D1 ADD.W D0,D1 SUB.W #D16Offset,D0 SUB.W #D16Offset+1,D1 MOVE.W D0,InitialSOLOffset(GP) MOVE.W D1,InitialEOLOffset(GP) ; Set the counter and bit buffer wrap offsets MOVE.W Height(GP),D0 SUBQ.W #1,D0 MULU Width(GP),D0 MOVE.L D0,CntrBufWrap(GP) MOVE.W Height(GP),D0 SUBQ.W #1,D0 MULU ActScrWidth(GP),D0 LSR.L #3,D0 MOVE.L D0,BitBufWrap(GP) ; And some more MOVE.W Height(GP),D0 SUBQ.W #2,D0 MOVE.W D0,MiddleLines(GP) ENDM ; INITPIX: This macro intializes all used screen pixels. P1 EQUR A1 P2 EQUR A2 P3 EQUR A3 P4 EQUR A4 P5 EQUR A6 CNTRFETCH EQUR A0 LINECOUNTER EQUR D0 SOLWORDOFF EQUR D1 EOLWORDOFF EQUR D2 WORDOFF EQUR D3 BITDOWNCOUNT EQUR D4 SHIFTBYTE EQUR D5 PLTEST EQUR D6 WIDTHINBYTES EQUR D7 InitPixRegs REG A0-A4/A6/D0-D7 INITPIX MACRO BRA.S .SetAllPlanes .PlaneBits DC.B 00001,%00011,%00010 DC.B %00110,%00111,%00101,%00100 DC.B %01100,%01101,%01111,%01110 DC.B %01010,%01011,%01001,%01000 DC.B %11000,%11001,%11011,%11010 DC.B %11110,%11111,%11101,%11100 DC.B %10100,%10101,%10111,%10110 DC.B %10010,%10011,%10001,%10000 EVEN .SetAllPlanes: PUSH InitPixRegs MOVE.L CntrBufBase(GP),CNTRFETCH MOVE.W Height(GP),LINECOUNTER MOVE.W InitialSOLOffset(GP),SOLWORDOFF MOVE.W InitialEOLOffset(GP),EOLWORDOFF MOVEQ #0,SHIFTBYTE MOVE.L Plane1(GP),P1 MOVE.L Plane2(GP),P2 MOVE.L Plane3(GP),P3 MOVE.L Plane4(GP),P4 MOVE.L Plane5(GP),P5 .DoNextLine: MOVE.W SOLWORDOFF,WORDOFF .DoForEachEight: MOVEQ #7,BITDOWNCOUNT .DoForEachByte: MOVE.B (CNTRFETCH)+,SHIFTBYTE SUBQ.B #4,SHIFTBYTE LSR.B #2,SHIFTBYTE MOVE.B .PlaneBits(PC,SHIFTBYTE.W),SHIFTBYTE LSR.B #1,SHIFTBYTE BCS.S .SetPlane1 BCLR BITDOWNCOUNT,0(P1,WORDOFF.W) BRA.S .Plane1Done .SetPlane1: BSET BITDOWNCOUNT,0(P1,WORDOFF.W) .Plane1Done: LSR.B #1,SHIFTBYTE BCS.S .SetPlane2 BCLR BITDOWNCOUNT,0(P2,WORDOFF.W) BRA.S .Plane2Done .SetPlane2: BSET BITDOWNCOUNT,0(P2,WORDOFF.W) .Plane2Done: MOVE.L P3,PLTEST BEQ.S .PlanesDone LSR.B #1,SHIFTBYTE BCS.S .SetPlane3 BCLR BITDOWNCOUNT,0(P3,WORDOFF.W) BRA.S .Plane3Done .SetPlane3: BSET BITDOWNCOUNT,0(P3,WORDOFF.W) .Plane3Done: MOVE.L P4,PLTEST BEQ.S .PlanesDone LSR.B #1,SHIFTBYTE BCS.S .SetPlane4 BCLR BITDOWNCOUNT,0(P4,WORDOFF.W) BRA.S .Plane4Done .SetPlane4: BSET BITDOWNCOUNT,0(P4,WORDOFF.W) .Plane4Done: MOVE.L P5,PLTEST BEQ.S .PlanesDone LSR.B #1,SHIFTBYTE BCS.S .SetPlane5 BCLR BITDOWNCOUNT,0(P5,WORDOFF.W) BRA.S .Plane5Done .SetPlane5: BSET BITDOWNCOUNT,0(P5,WORDOFF.W) .Plane5Done: .PlanesDone SUBQ.W #1,BITDOWNCOUNT BPL .DoForEachByte ADDQ.W #1,WORDOFF CMP.W EOLWORDOFF,WORDOFF BLE .DoForEachEight MOVE.W ActScrWidth(GP),WIDTHINBYTES LSR.W #3,WIDTHINBYTES ADD.W WIDTHINBYTES,SOLWORDOFF ADD.W WIDTHINBYTES,EOLWORDOFF SUBQ.W #1,LINECOUNTER BNE .DoNextLine PULL InitPixRegs ENDM ; These are the register assignments used in the computation loop ; Constant address registers BOOLBAS1 EQUR A0 BOOLBAS2 EQUR A1 TABLES EQUR A2 ; Variable address registers PLANEPTR EQUR A3 CNTRPTR EQUR A4 SOLOFFSET EQUR A6 ; Constant data registers MINWIDTH EQUR D0 PLSWIDTH EQUR D1 ; Variable data registers BITCNTR EQUR D2 OFFSET EQUR D3 EOLOFFSET EQUR D4 CURRCNTR EQUR D5 <= locked (> D1) PLUS2CNTR EQUR D6 LINEDOWNCOUNT EQUR D7 INITREGS MACRO MOVE.L IncBoolBitBuf1(GP),BOOLBAS1 LEA D16Offset(BOOLBAS1),BOOLBAS1 MOVE.L IncBoolBitBuf2(GP),BOOLBAS2 LEA D16Offset(BOOLBAS2),BOOLBAS2 LEA TableStruc+2*4(GP),TABLES MOVE.W Width(GP),MINWIDTH MOVE.W MINWIDTH,PLSWIDTH NEG.W MINWIDTH MOVEQ #0,BITCNTR MOVEQ #0,OFFSET MOVEQ #0,EOLOFFSET MOVEQ #0,CURRCNTR MOVEQ #0,PLUS2CNTR MOVEQ #0,LINEDOWNCOUNT ENDM ; Combine the three initialization macros INITALL MACRO INITVARS INITPIX INITREGS ENDM ; This macro increments a counter and adapts a pixel's colour INCIT MACRO MOVE.B (CNTRPTR),CURRCNTR MOVE.B d8_CounterValues+2*4(TABLES,CURRCNTR.W),PLUS2CNTR BNE.S NoColourOverflow\@ MOVE.L Plane1(GP),PLANEPTR BSET BITCNTR,0(PLANEPTR,OFFSET.W) MOVE.L Plane2(GP),PLANEPTR BCLR BITCNTR,0(PLANEPTR,OFFSET.W) MOVE.L Plane3(GP),PLUS2CNTR BEQ.S PlanesDone\@ MOVE.L PLUS2CNTR,PLANEPTR BCLR BITCNTR,0(PLANEPTR,OFFSET.W) MOVE.L Plane4(GP),PLUS2CNTR BEQ.S PlanesDone\@ MOVE.L PLUS2CNTR,PLANEPTR BCLR BITCNTR,0(PLANEPTR,OFFSET.W) MOVE.L Plane5(GP),PLUS2CNTR BEQ.S PlanesDone\@ MOVE.L PLUS2CNTR,PLANEPTR BCLR BITCNTR,0(PLANEPTR,OFFSET.W) PlanesDone\@: MOVEQ #8,PLUS2CNTR MOVE.B #4,(CNTRPTR) BRA.S PixelSet\@ NoColourOverflow\@: MOVE.L d8_PlaneBasePtrs(TABLES,CURRCNTR.W),PLANEPTR BCHG BITCNTR,0(PLANEPTR,OFFSET.W) ADDQ.B #4,(CNTRPTR) PixelSet\@: ENDM ; These CHK.. macros check with neighbours and set the boolbuffer accordingly. CHKLEFTWRAP MACRO BTST #0,0(BOOLBAS1,EOLOFFSET.W) BNE.S NeigMarked\@ CMP.B -1(CNTRPTR,PLSWIDTH.W),PLUS2CNTR BNE.S NoNewInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNewInc\@: CMP.B -1(CNTRPTR,PLSWIDTH.W),CURRCNTR BNE.S NoNeigInc\@ BSET #0,0(BOOLBAS2,EOLOFFSET.W) NoNeigInc\@: NeigMarked\@: ENDM CHKLEFTOVER MACRO CMP.B -1(CNTRPTR),PLUS2CNTR BNE.S NoNewInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNewInc\@: CMP.B -1(CNTRPTR),CURRCNTR BNE.S NoNeigInc\@ BSET #0,-1(BOOLBAS2,OFFSET.W) NoNeigInc\@: ENDM CHKLEFTNEIG MACRO CMP.B -1(CNTRPTR),PLUS2CNTR BNE.S NoNewInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNewInc\@: CMP.B -1(CNTRPTR),CURRCNTR BNE.S NoNeigInc\@ ADDQ.B #1,BITCNTR BSET BITCNTR,0(BOOLBAS2,OFFSET.W) SUBQ.B #1,BITCNTR NoNeigInc\@: ENDM CHKTOPWRAP MACRO ADD.L BitBufWrap(GP),BOOLBAS1 BTST BITCNTR,0(BOOLBAS1,OFFSET.W) BNE.S NeigMarked\@ ADD.L CntrBufWrap(GP),CNTRPTR CMP.B (CNTRPTR),PLUS2CNTR BNE.S NoNewInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNewInc\@: CMP.B (CNTRPTR),CURRCNTR BNE.S NoNeigInc\@ ADD.L BitBufWrap(GP),BOOLBAS2 BSET BITCNTR,0(BOOLBAS2,OFFSET.W) SUB.L BitBufWrap(GP),BOOLBAS2 NoNeigInc\@: SUB.L CntrBufWrap(GP),CNTRPTR NeigMarked\@: SUB.L BitBufWrap(GP),BOOLBAS1 ENDM CHKTOPNEIG MACRO CMP.B 0(CNTRPTR,MINWIDTH.W),PLUS2CNTR BNE.S NoNewInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNewInc\@: CMP.B 0(CNTRPTR,MINWIDTH.W),CURRCNTR BNE.S NoNeigInc\@ BSET BITCNTR,-\1/8(BOOLBAS2,OFFSET.W) NoNeigInc\@: ENDM CHKRIGHTWRAP MACRO CMP.B 1(CNTRPTR,MINWIDTH.W),PLUS2CNTR BNE.S NoNewInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNewInc\@: CMP.B 1(CNTRPTR,MINWIDTH.W),CURRCNTR BNE.S NoNeigInc\@ BSET #7,0(BOOLBAS2,SOLOFFSET.W) NoNeigInc\@: ENDM CHKRIGHTOVER MACRO TST.B 1(BOOLBAS1,OFFSET.W) BMI.S NeigMarked\@ CMP.B 1(CNTRPTR),PLUS2CNTR BNE.S NoNewInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNewInc\@: CMP.B 1(CNTRPTR),CURRCNTR BNE.S NoNeigInc\@ BSET #7,1(BOOLBAS2,OFFSET.W) NoNeigInc\@: NeigMarked\@: ENDM CHKRIGHTNEIG MACRO SUBQ.B #1,BITCNTR BTST.B BITCNTR,0(BOOLBAS1,OFFSET.W) BNE.S NeigMarked\@ CMP.B 1(CNTRPTR),CURRCNTR BNE.S NoNeigInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNeigInc\@: CMP.B 1(CNTRPTR),PLUS2CNTR BNE.S NoNewInc\@ ADDQ.B #1,BITCNTR BSET BITCNTR,0(BOOLBAS2,OFFSET.W) BRA.S MacDone\@ NoNewInc\@: NeigMarked\@: ADDQ.B #1,BITCNTR MacDone\@: ENDM CHKBOTTOMWRAP MACRO SUB.L CntrBufWrap(GP),CNTRPTR CMP.B (CNTRPTR),PLUS2CNTR BNE.S NoNewInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNewInc\@: CMP.B (CNTRPTR),CURRCNTR BNE.S NoNeigInc\@ SUB.L BitBufWrap(GP),BOOLBAS2 BSET BITCNTR,0(BOOLBAS2,OFFSET.W) ADD.L BitBufWrap(GP),BOOLBAS2 NoNeigInc\@: ADD.L CntrBufWrap(GP),CNTRPTR ENDM CHKBOTTOMNEIG MACRO BTST BITCNTR,\1/8(BOOLBAS1,OFFSET.W) BNE.S NeigMarked\@ CMP.B 0(CNTRPTR,PLSWIDTH.W),PLUS2CNTR BNE.S NoNewInc\@ BSET BITCNTR,0(BOOLBAS2,OFFSET.W) NoNewInc\@: CMP.B 0(CNTRPTR,PLSWIDTH.W),CURRCNTR BNE.S NoNeigInc\@ BSET BITCNTR,\1/8(BOOLBAS2,OFFSET.W) NoNeigInc\@: NeigMarked\@: ENDM ; These 3 macros are for the leftmost, middle and rightmost pixel-bytes DOLEFT MACRO MOVE.W SOLOFFSET,OFFSET TST.B 0(BOOLBAS1,OFFSET.W) BEQ NoIncPixels\@ BPL NotLeftPixel\@ MOVEQ #7,BITCNTR INCIT CHKLEFTWRAP \1 CHKTOP\2 \1 CHKRIGHTNEIG \1 CHKBOTTOM\3 \1 NotLeftPixel\@: MOVEQ #6,BITCNTR CheckNextMidPixel\@: ADDQ.L #1,CNTRPTR BTST BITCNTR,0(BOOLBAS1,OFFSET.W) BEQ NotThisMidPixel\@ INCIT CHKLEFTNEIG \1 CHKTOP\2 \1 CHKRIGHTNEIG \1 CHKBOTTOM\3 \1 NotThisMidPixel\@: SUBQ.B #1,BITCNTR BNE CheckNextMidPixel\@ ADDQ.L #1,CNTRPTR BTST BITCNTR,0(BOOLBAS1,OFFSET.W) BEQ NotThisRightPixel\@ INCIT CHKLEFTNEIG \1 CHKTOP\2 \1 CHKRIGHTOVER \1 CHKBOTTOM\3 \1 NotThisRightPixel\@: CLR.B 0(BOOLBAS1,OFFSET.W) SUBQ.L #7,CNTRPTR NoIncPixels\@: ADDQ.L #8,CNTRPTR ADDQ.W #1,OFFSET ENDM DOMIDDLE MACRO DoNextEight\@: TST.B 0(BOOLBAS1,OFFSET.W) BEQ NoIncPixels\@ BPL NotLeftPixel\@ MOVEQ #7,BITCNTR INCIT CHKLEFTOVER \1 CHKTOP\2 \1 CHKRIGHTNEIG \1 CHKBOTTOM\3 \1 NotLeftPixel\@: MOVEQ #6,BITCNTR CheckNextMidPixel\@: ADDQ.L #1,CNTRPTR BTST BITCNTR,0(BOOLBAS1,OFFSET.W) BEQ NotThisMidPixel\@ INCIT CHKLEFTNEIG \1 CHKTOP\2 \1 CHKRIGHTNEIG \1 CHKBOTTOM\3 \1 NotThisMidPixel\@: SUBQ.B #1,BITCNTR BNE CheckNextMidPixel\@ ADDQ.L #1,CNTRPTR BTST BITCNTR,0(BOOLBAS1,OFFSET.W) BEQ NotThisRightPixel\@ INCIT CHKLEFTNEIG \1 CHKTOP\2 \1 CHKRIGHTOVER \1 CHKBOTTOM\3 \1 NotThisRightPixel\@: CLR.B 0(BOOLBAS1,OFFSET.W) SUBQ.L #7,CNTRPTR NoIncPixels\@: ADDQ.L #8,CNTRPTR ADDQ.W #1,OFFSET CMP.W EOLOFFSET,OFFSET BNE DoNextEight\@ ENDM DORIGHT MACRO TST.B 0(BOOLBAS1,OFFSET.W) BEQ NoIncPixels\@ BPL NotLeftPixel\@ MOVEQ #7,BITCNTR INCIT CHKLEFTOVER \1 CHKTOP\2 \1 CHKRIGHTNEIG \1 CHKBOTTOM\3 \1 NotLeftPixel\@: MOVEQ #6,BITCNTR CheckNextMidPixel\@: ADDQ.L #1,CNTRPTR BTST BITCNTR,0(BOOLBAS1,OFFSET.W) BEQ NotThisMidPixel\@ INCIT CHKLEFTNEIG \1 CHKTOP\2 \1 CHKRIGHTNEIG \1 CHKBOTTOM\3 \1 NotThisMidPixel\@: SUBQ.B #1,BITCNTR BNE CheckNextMidPixel\@ ADDQ.L #1,CNTRPTR BTST BITCNTR,0(BOOLBAS1,OFFSET.W) BEQ NotThisRightPixel\@ INCIT CHKLEFTNEIG \1 CHKTOP\2 \1 CHKRIGHTWRAP \1 CHKBOTTOM\3 \1 NotThisRightPixel\@: CLR.B 0(BOOLBAS1,OFFSET.W) SUBQ.L #7,CNTRPTR NoIncPixels\@: ADDQ.L #8,CNTRPTR ADD.W #\1/8,SOLOFFSET ADD.W #\1/8,EOLOFFSET ENDM ; These three macros are for the top, middle and bottom lines DOTOP MACRO DOLEFT \1,WRAP,NEIG DOMIDDLE \1,WRAP,NEIG DORIGHT \1,WRAP,NEIG ENDM DOMID MACRO DOLEFT \1,NEIG,NEIG DOMIDDLE \1,NEIG,NEIG DORIGHT \1,NEIG,NEIG ENDM DOBOT MACRO DOLEFT \1,NEIG,WRAP DOMIDDLE \1,NEIG,WRAP DORIGHT \1,NEIG,WRAP ENDM ; This is the big one (\1 must be the acual screen width) COMPUTE MACRO ADDQ.L #1,CycleCounter(GP) MOVE.W InitialSOLOffset(GP),SOLOFFSET MOVE.W InitialEOLOffset(GP),EOLOFFSET MOVE.L CntrBufBase(GP),CNTRPTR DOTOP \1 MOVE.W MiddleLines(GP),LINEDOWNCOUNT DoNextMiddleLine\@: DOMID \1 SUBQ.W #1,LINEDOWNCOUNT BNE DoNextMiddleLine\@ DOBOT \1 EXG.L BOOLBAS1,BOOLBAS2 ENDM ;------------------------ ; The display sub-program ;------------------------ EvolveTheCyclicSpace: XBSR RunSubProgram ; Show the user how to abort sometime before the screen opens CLRBREAK CONTEXT <'Press CTRL-C to abort.',10> CONTEXT <'Initializing'> ; Allocate the buffer for the counters GLONG CntrBufBase MOVE.W Height(GP),D0 MULU Width(GP),D0 MOVEQ #0,D1 XBSR AllocateMemory BEQ CleanupSubProg MOVE.L A0,CntrBufBase(GP) ; Allocate the first increment boolean bit buffer and set all to TRUE GLONG IncBoolBitBuf1 GLONG IncBoolBitBufSize CONTEXT <'.'> MOVE.W Height(GP),D0 MULU ActScrWidth(GP),D0 LSR.L #3,D0 MOVE.L D0,IncBoolBitBufSize(GP) MOVEQ #0,D1 XBSR AllocateMemory BEQ CleanupSubProg MOVE.L A0,IncBoolBitBuf1(GP) SetBoolBitsTrue: ST (A0)+ SUBQ.L #1,D0 BNE SetBoolBitsTrue ; Allocate the second increment boolean bit buffer with all set FALSE GLONG IncBoolBitBuf2 CONTEXT <'.'> MOVE.L IncBoolBitBufSize(GP),D0 MOVE.L #MEMF_CLEAR,D1 XBSR AllocateMemory BEQ CleanupSubProg MOVE.L A0,IncBoolBitBuf2(GP) ; Initialize the cyclic counter buffer with random values. AMOUNTCOUNT EQUR D2 CNTRVAL1 EQUR D3 CNTRVAL2 EQUR D4 CNTRBUFPTR EQUR A2 CONTEXT <'.'> MOVE.W Width(GP),AMOUNTCOUNT MULU Height(GP),AMOUNTCOUNT MOVE.L CntrBufBase(GP),CNTRBUFPTR MOVE.L Seed(GP),D0 XBSR SeedLongRnd ComputeNextRandomCounter: XBSR LongRnd MOVEQ #0,CNTRVAL1 MOVEQ #0,CNTRVAL2 SWAP D0 MOVE.W D0,CNTRVAL1 SWAP D0 MOVE.W D0,CNTRVAL2 DIVU Depth(GP),CNTRVAL1 DIVU Depth(GP),CNTRVAL2 SWAP CNTRVAL1 SWAP CNTRVAL2 LSL.B #2,CNTRVAL1 LSL.B #2,CNTRVAL2 ADDQ.B #4,CNTRVAL1 ADDQ.B #4,CNTRVAL2 MOVE.B CNTRVAL1,(CNTRBUFPTR)+ MOVE.B CNTRVAL2,(CNTRBUFPTR)+ SUBQ.L #2,AMOUNTCOUNT BNE ComputeNextRandomCounter ; Open the screen GLONG ScreenBase GWORD ActScrWidth LEA NewScreen(GP),A0 CALL intuition,OpenScreen MOVE.L D0,ScreenBase(GP) BNE.S ScreenOpenedOK XBSTR SetErrorConStr,<'Could not open screen.'> BRA CleanupSubProg ScreenOpenedOK: MOVE.L D0,A0 MOVE.W ActScrDepth(GP),D1 MOVEQ #0,D0 BSET D1,D0 LEA sc_ViewPort(A0),A0 LEA ColourMap(GP),A1 CALL graphics,LoadRGB4 ; These tables are all ind.-indexed with as base the "TABLES" address register. d8_PlaneBasePtrs = -2*4 d8_CounterValues = -2*4+(1+31-1)*4 GSTRUC TableStruc,(1+31-1)*4+(1+31+2)*4 ; Initialize the counter value table LEA TableStruc+2*4(GP),A0 MOVEQ #0,D0 SetNextTabCntByte: ADDQ.W #1,D0 LSL.W #2,D0 MOVE.B D0,d8_CounterValues(A0,D0.W) LSR.W #2,D0 CMP.W Depth(GP),D0 BNE SetNextTabCntByte LSL.W #2,D0 MOVE.B #4,d8_CounterValues+4(A0,D0.W) CLR.B d8_CounterValues+2*4(A0,D0.W) ; Initialize the bitplane pointer table BRA.S SkipBitChangeTable BitChangeTable: DC.B 4*0,4*1,4*0,4*2,4*0,4*1,4*0,4*3 DC.B 4*0,4*1,4*0,4*2,4*0,4*1,4*0,4*4 DC.B 4*0,4*1,4*0,4*2,4*0,4*1,4*0,4*3 DC.B 4*0,4*1,4*0,4*2,4*0,4*1,4*0,4*5 EVEN SkipBitChangeTable: LEA TableStruc+2*4+d8_PlaneBasePtrs(GP),A0 MOVE.L ScreenBase(GP),A1 LEA sc_BitMap+bm_Planes(A1),A1 MOVEQ #0,D0 MOVEQ #0,D1 InitNextPlanePtr: MOVE.B BitChangeTable(PC,D0.W),D1 MOVE.L 0(A1,D1.W),(A0) ADD.L #D16Offset,(A0)+ ADDQ.W #1,D0 CMP.W Depth(GP),D0 BNE InitNextPlanePtr ; Reset cycle counter, clear "init.." line and reset dropped boolean GLONG CycleCounter CLR.L CycleCounter(GP) CONTEXT <$D,$9B,'1K'> SF Dropped(GP) ; Start the cellular automat (scrambles all regs except A5 & A7) BreakRegs REG D0/A0/D1/A1/A6 INITALL DoComputation: CMP.W #640,ActScrWidth(GP) BEQ DoWideVersion DoNarrowVersion: MOVEQ #0,CURRCNTR COMPUTE 320 IFBREAK UserBreak TST.B CURRCNTR BEQ StationaryState BRA DoNarrowVersion DoWideVersion: MOVEQ #0,CURRCNTR COMPUTE 640 IFBREAK UserBreak TST.B CURRCNTR BEQ StationaryState BRA DoWideVersion ; User hit ^-C. Save scratch regs used by display routine. UserBreak: PUSH BreakRegs ; Display cycle number and check if quit was due to stationary state StationaryState: BSR DropScreen BSR UpLine CONTEXT <'Number of computation cycles: '> PRDEC.L CycleCounter(GP) CONTEXT <10> TST.B CURRCNTR BNE.S ThisBeRealBreak CONTEXT <'Automata reached stationary state. [ENTER]'> BSR InDeci BRA CleanupSubProg ; So, what next sucker? ThisBeRealBreak: CONTEXT <10> RetryWhatNextInput: BSR UpLine CONTEXT <'[A]bort, [C]ontinue or [S]tep ?'> XBSR StdReadStr MOVE.B (A0),D0 AND.B #$DF,D0 CMP.B #'A',D0 BEQ.S AbortComputation CMP.B #'C',D0 BEQ.S RestartComputation CMP.B #'S',D0 BEQ.S DoOneComputationCycle BRA RetryWhatNextInput ; Clear the break flag and continue RestartComputation: BSR UpLine BSR UpLine CONTEXT <'Press CTRL-C to abort.',10> CLRBREAK BSR PopScreen PULL BreakRegs BRA DoComputation ; Reset cursor and continue DoOneComputationCycle: CONTEXT <$D,$B> PULL BreakRegs BRA DoComputation ; Got user request to abort AbortComputation: PULL BreakRegs ; Subprogram resource cleanup and error processing. (Screens not tracked yet) CleanupSubProg: MOVE.L ScreenBase(GP),D0 BEQ.S ScreenNotOpened MOVE.L D0,A0 CALL intuition,CloseScreen CLR.L ScreenBase(GP) ScreenNotOpened: MOVE.L ErrorStrSize(GP),D0 BEQ.S NoErrorString CONTEXT <$D,$9B,'1K'> BSR UpLine LEA ErrorStr(GP),A0 XBSR StdWrite CONTEXT <10,'Try to reduce space dimensions. RETURN'> BSR InDeci XBSR ClrErrorStr NoErrorString: RTS END ;--------------------------------------------------------- ; A stylized and simplified version of the display routine ;--------------------------------------------------------- Bč = Buffer with bools indicating which pixels need to be incremented during this space update BČ = Buffer with bools indicating which pixels need to be incremented during the next space update X = Pixel index Cntr = Counter of pixel in cyclic space ProcNe = Already processed neighbour of pixel in C.S. UnprNe = Not yet processed neighbour od pixel in C.S. DO FOR ALL X DO IF Bč(X) <> 0 FOR ALL ProcNe(X) DO IF Cntr(X) = Cntr(ProcNe(X)) Set(BČ(ProcNe(X))) IF Cntr(X)+2 = Cntr(ProcNe(X)) Set(BČ(X)) FOR ALL UnprNe(X) DO IF Bč(UnprNe(X)) = 0 IF Cntr(X) = Cntr(UnprNe(X)) Set(BČ(UnprNe(X))) IF Cntr(X)+2 = Cntr(UnprNe(X)) Set(BČ(X)) Cntr(X) = Cntr(X)+1 Bč(X) = 0 SETPIXEL(X,Cntr(X)) Exchange(Bč,BČ) UNTIL CTRL-C