From fcb7b340c0c50feddfd0b1a4b2df25e41c374a12 Mon Sep 17 00:00:00 2001 From: hachti Date: Tue, 29 May 2007 04:33:32 +0000 Subject: [PATCH] *** empty log message *** --- lib/fortran/src/pchar.asm | 2 +- lib/iolib/Makefile | 2 +- lib/iolib/recipe/io.recipe | 3 +- lib/iolib/src/pl$mv.asm | 209 +++++++++++++++++ lib/iolib/src/pl$u.asm | 147 ++++++++++++ programs/plotter/src/achja.f | 46 ++++ programs/plotter/src/nikolaussiedlung.f | 38 ++++ programs/plotter/src/plotapfel.f | 285 +++++++++++++++++++++++ programs/plotter/src/plotapfel2.f | 290 ++++++++++++++++++++++++ programs/plotter/src/plottest.f | 59 +++++ programs/plotter/src/plottest2.f | 38 ++++ programs/plotter/src/stern.f | 29 +++ simh/boot.do | 8 + simh/slst.do | 12 + 14 files changed, 1165 insertions(+), 3 deletions(-) create mode 100644 lib/iolib/src/pl$mv.asm create mode 100644 lib/iolib/src/pl$u.asm create mode 100644 programs/plotter/src/achja.f create mode 100644 programs/plotter/src/nikolaussiedlung.f create mode 100644 programs/plotter/src/plotapfel.f create mode 100644 programs/plotter/src/plotapfel2.f create mode 100644 programs/plotter/src/plottest.f create mode 100644 programs/plotter/src/plottest2.f create mode 100644 programs/plotter/src/stern.f create mode 100644 simh/boot.do create mode 100644 simh/slst.do diff --git a/lib/fortran/src/pchar.asm b/lib/fortran/src/pchar.asm index 60a9a43..8c1810a 100644 --- a/lib/fortran/src/pchar.asm +++ b/lib/fortran/src/pchar.asm @@ -4,7 +4,7 @@ ****** USAGE * * JST PCHAR -* DAC Arg1 +* DAC Arg1-Addr * * * diff --git a/lib/iolib/Makefile b/lib/iolib/Makefile index 9675593..5a2d883 100644 --- a/lib/iolib/Makefile +++ b/lib/iolib/Makefile @@ -11,7 +11,7 @@ export ORG_OBJDIR=org export MAKE -MODULES = o$$al o$$la o$$pl o$$pb i$$pa pl$$up +MODULES = o$$al o$$la o$$pl o$$pb i$$pa pl$$u pl$$mv FRTN_COMMAND = frtn_original ASM_COMMAND = asm_original diff --git a/lib/iolib/recipe/io.recipe b/lib/iolib/recipe/io.recipe index 9858e90..08ea242 100644 --- a/lib/iolib/recipe/io.recipe +++ b/lib/iolib/recipe/io.recipe @@ -25,6 +25,7 @@ org/O$AI #org/O$AH Original ASR listing routine #org/O$AH -obj/PL$UP +obj/PL$MV +obj/PL$U diff --git a/lib/iolib/src/pl$mv.asm b/lib/iolib/src/pl$mv.asm new file mode 100644 index 0000000..b202b72 --- /dev/null +++ b/lib/iolib/src/pl$mv.asm @@ -0,0 +1,209 @@ +* (PL$MV) REV 1.0 INCREMENTAL PLOTTER ROUTINES +* +* +* PROGRAM TITLE: +* PL$MV (PL$MV,PL$RST) +* +* PLOTTER MOVEMENT ROUTINES +* +* +* REVISIONS: +* 1.0 (2007-05-28) +* +* AUTHOR: +* +* PHILIPP HACHTMANN +* +* +* PURPOSE: +* +* PROVIDE SIMPLE LIBRARY FUNCTIONS FOR INCREMENTAL PLOTTERS +* +* +* STORAGE: +* +* ??? (OCTAL) +* ??? (DECIMAL) +* +* +* USAGE +* +* CALL PL$RST - SET VIRTUAL PLOT POSITION TO ZERO +* +* CALL PL$MV - MOVE TO POINT SPECIFIED +* DAC XN BY XN +* DAC YN AND YN VALUE +* +* +* +******************************************************************************** +* +* + SUBR PL$MV,MOVE + SUBR PL$RST,RST +* +* + REL THIS IS A RELOCATABLE OBJECT + ORG '0 +* +* +RST DAC ** SET POINT ZERO + STA X + CRA + STA Y + IMA X + JMP* RST +* +* +MOVE DAC ** MOVE YA! +* + LDA* MOVE GET PARAMETERS + STA TMP + LDA* TMP + STA XN + SUB X + STA DX + IRS MOVE + LDA* MOVE + STA TMP + LDA* TMP + STA YN + SUB Y + STA DY + IRS MOVE + IRS MOVE CORRECT RETURN ADDRESS +* +* HLT +* LDA YN +* IAB +* LDA XN +* HLT +* JMP 1 +* + LDA DX + SMI + JMP DXP DX POSITIVE +* DX NEGATIVE + TCA + STA DX NOW, DX IS POSITIVE! + LDA ML + STA STPX + LDA MUL + STA DIYP + LDA MDL + STA DIYN + JMP DXNP +DXP LDA MR + STA STPX + LDA MUR + STA DIYP + LDA MDR + STA DIYN + JMP DXNP +* +DXNP LDA DY + SMI + JMP DYP DY POSITIVE +* DY NEGATIVE + TCA + STA DY NOW, DY IS POSITIVE! + LDA MD + STA STPY + LDA DIYN + STA STPD + JMP DYNP +DYP LDA MU + STA STPY + LDA DIYP + STA STPD +* +DYNP LDA DX + CAS DY + JMP XGTY DX GREATER DY +YGTX NOP DY GREATER OR EQUAL DX + LDA STPY + STA STPL + LDA STPX + STA STPS + LDA DX + STA DS + LDA DY + STA DL + JMP GTE +* +XGTY LDA STPY + STA STPS + LDA STPX + STA STPL + LDA DX + STA DL + LDA DY + STA DS +* +GTE LDA DL LONG DISTANCE + LGR 1 DIVIDE BY TWO + STA ERR INITIALIZE ERROR COUNTER +* +* +* +LOOP LDA DL + SNZ + JMP FNSH END OF WORK - HOPE SO.... + SUB =1 DECREMENT DL + STA DL + LDA ERR + SUB DS + STA ERR + SMI SKIP IF NOT OVERFLOWN (MINUS) + JMP NDIA NO DIAG STEP + ADD DL RELOAD + STA ERR + LDA DS + SUB =1 + STA DS + JST* STPD + JMP STEN END OF STEP +NDIA JST* STPL LONG DIR STEP ONLY +STEN JMP LOOP RELOOP +* +FNSH LDA XN + STA X + LDA YN + STA Y + JMP* MOVE END OF THE ROUTINE +********************** +* +* VARIABLES +* +X DEC 0 PEN POSITION, X VALUE +Y DEC 0 PEN POSITION, Y VALUE +XN DEC 0 NEW PEN POSITION, X VALUE +YN DEC 0 NEW PEN POSITION, Y VALUE +DX DEC 0 X DIFFERENCE TO GO +DY DEC 0 Y DIFFERENCE TO GO +* +DL DEC 0 LONG DISTANCE NEGATIVE +DS DEC 0 SHORT DISTANCE NEGATIVE +STPL DAC ** ROUTINE TO LONG DISTANCE STEP +STPS DAC ** ROUTINE TO SHORT DISTANCE STEP +STPD DAC ** ROUTINE TO DIAGONAL STEP +ERR DEC 0 ERROR COUNTER +* +STPX DAC ** X STEP ROUTINE +STPY DAC ** Y STEP ROUTINE +DIYP DAC ** DIAGONAL X-DIR+UP STEP ROUTINE +DIYN DAC ** DIAGONAL X-DIR+DOWN STEP ROUTINE +TMP DAC ** UNIVERSAL POINTER +* +* GLUE IN THE MOVEMENT +MU XAC PL$U +MD XAC PL$D +ML XAC PL$L +MR XAC PL$R +MUL XAC PL$UL +MUR XAC PL$UR +MDL XAC PL$DL +MDR XAC PL$DR +* +* + END diff --git a/lib/iolib/src/pl$u.asm b/lib/iolib/src/pl$u.asm new file mode 100644 index 0000000..4c0dcb6 --- /dev/null +++ b/lib/iolib/src/pl$u.asm @@ -0,0 +1,147 @@ +* (PL$U) REV 1.0 LOW LEVEL INCREMENTAL PLOTTER DRIVER +* +* +* PROGRAM TITLE: PL$U (PL$U, PL$D, PL$L, PL$R, PL$PU, PL$PD, +* PL$UR,PL$UL,PL$DR,PL$DL) +* +* LOW LEVEL PEN PLOTTER ROUTINES +* +* REVISIONS: +* 1.0 (2007-05-27) +* +* AUTHOR: +* +* PHILIPP HACHTMANN +* +* +* PURPOSE: +* +* LOW LEVEL PEN PLOTTER DRIVER ROUTINES PROVIDING HARDWARE +* ABSTRACTION BY PROVIDING SIMPLE ROUTINES FOR PEN MOVEMENT. +* +* +* STORAGE: +* +* ??? (OCTAL) +* ??? (DECIMAL) +* +* +* USAGE: +* +* CALL PL$U - STEP UP +* CALL PL$D - STEP DOWN +* CALL PL$L - STEP LEFT +* CALL PL$R - STEP RIGHT +* CALL PL$PU - RAISE PEN +* CALL PL$PD - LOWER PEN +* +* CALL PL$UR - STEP UP+RIGHT +* CALL PL$UL - STEP UP+LEFT +* CALL PL$DR - STEP DOWN+RIGHT +* CALL PL$DL - STEP DOWN+LEFT +* +* +* +******************************************************************************** +* +* +PADR EQU '40 PORT ADDRESS OF THE PLOTTER INTERFACE +* +* + SUBR PL$UP,UP + SUBR PL$U,UP + SUBR PL$D,DOWN + SUBR PL$R,RGHT + SUBR PL$L,LEFT + SUBR PL$PU,PENU + SUBR PL$PD,PEND + SUBR PL$UR,UR + SUBR PL$UL,UL + SUBR PL$DR,DR + SUBR PL$DL,DL +* +* + REL THIS IS A RELOCATABLE OBJECT + ORG '0 +* +* +OUT DAC ** DO THE MOVEMENT + OTA PADR + JMP *-1 + JMP* OUT +* +* +UP DAC ** + LDA CUP + JST OUT + JMP* UP +* +* +DOWN DAC ** + LDA CDWN + JST OUT + JMP* DOWN +* +* +RGHT DAC ** + LDA CRGT + JST OUT + JMP* RGHT +* +* +LEFT DAC ** + LDA CLFT + JST OUT + JMP* LEFT +* +* +PENU DAC ** + LDA CPNU + JST OUT + JMP* PENU +* +* +PEND DAC ** + LDA CPND + JST OUT + JMP* PEND +* +* +UL DAC ** + LDA CUP + ADD CLFT + JST OUT + JMP* UL +* +* +UR DAC ** + LDA CUP + ADD CRGT + JST OUT + JMP* UR +* +* +DL DAC ** + LDA CDWN + ADD CLFT + JST OUT + JMP* DL +* +* +DR DAC ** + LDA CDWN + ADD CRGT + JST OUT + JMP* DR +* +* +* CONSTANTS +CUP OCT '1 +CDWN OCT '2 +CLFT OCT '4 +CRGT OCT '10 +CPNU OCT '20 +CPND OCT '40 +* +* + END diff --git a/programs/plotter/src/achja.f b/programs/plotter/src/achja.f new file mode 100644 index 0000000..3907f30 --- /dev/null +++ b/programs/plotter/src/achja.f @@ -0,0 +1,46 @@ +C ACH JA, DAS AUCH +C +C + INTEGER X,Y +C +C + 1000 CALL PL$RST + DO 2000 X=0,600,50 + CALL LINE(X,-100,X,100) + 2000 CONTINUE + + 1500 DO 1600 Y=0,200,50 + CALL LINE(0,Y-100,600,Y-100) + 1600 CONTINUE + CALL LINE (0,1,600,1) + CALL LINE (0,-1,600,-1) +C + CALL PL$MV(0,0) + CALL PL$PD + DO 3000 X=0,600 + TMP=X + PHI=(3.141/180.0)*TMP + Y=SIN(PHI)*90.0 + CALL PL$MV(X,Y) + 3000 CONTINUE + CALL PL$PU +C +C +C + CALL PL$MV(0,0) + CALL REBOOT + END +C +C +C + SUBROUTINE LINE(X1,Y1,X2,Y2) + INTEGER X1,Y1,X2,Y2 + CALL PL$MV(X1,Y1) + CALL PL$PD + CALL PL$MV(X2,Y2) + CALL PL$PU + RETURN + END +$0 + + diff --git a/programs/plotter/src/nikolaussiedlung.f b/programs/plotter/src/nikolaussiedlung.f new file mode 100644 index 0000000..9a45c5e --- /dev/null +++ b/programs/plotter/src/nikolaussiedlung.f @@ -0,0 +1,38 @@ +C PLOTTER TEST PROGRAM +C +C + CALL PL$RST + + CALL PL$PD + CALL PL$MV(610,0) + CALL PL$MV(610,95) + CALL PL$MV(0,95) + CALL PL$MV(0,0) + CALL PL$MV(1,1) + CALL PL$MV(609,1) + CALL PL$MV(609,94) + CALL PL$MV(1,94) + CALL PL$MV(1,1) + CALL PL$PU + CALL PL$MV(10,10) + + DO 1000 I=1,10 + CALL PL$RST + CALL PL$PD + CALL PL$MV(0,50) + CALL PL$MV(25,75) + CALL PL$MV(50,50) + CALL PL$MV(0,50) + CALL PL$MV(50,0) + CALL PL$MV(50,50) + CALL PL$MV(0,0) + CALL PL$MV(50,0) + CALL PL$PU + CALL PL$MV(60,0) + 1000 CONTINUE + CALL PL$MV(-540,-10) +C +C +10000 CALL REBOOT + END +$0 diff --git a/programs/plotter/src/plotapfel.f b/programs/plotter/src/plotapfel.f new file mode 100644 index 0000000..ab4365d --- /dev/null +++ b/programs/plotter/src/plotapfel.f @@ -0,0 +1,285 @@ +C APFELMAENNCHEN-PROGRAMM, 06.FEBRUARY.2007 PHILIPP HACHTMANN +C INTERMEDIATE VERSION +C +C THIS VERSION SHOULD RUN A BIT FASTER BECAUSE THE SQUARE +C ROOT IS OMMITTED. +C +C SWITCH SETTINGS: +C SENSE-SWITCH 1: IF SET, ASK FOR PARAMETERS +C SENSE-SWITCH 2: IF SET, DON'T PRINT PARAMETERS ON START +C SENSE-SWITCH 3: IF SET, RESTORE PARAMETERS TO DEFAULT VALUES +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +C COMMON BLOCK DECLARATIONS +C + INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA + COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA +C + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP +C + INTEGER INIT + COMMON /PARAM3/INIT +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +C CONFIGURATION +CCCCCC RESET DO DEFAULT VALUES? + 110 CALL SSWTCH(3,I) + IF (I.EQ.1) CALL RST +C +CCCCCC ON THE FIRST START OR IF DESIRED + IF(INIT.EQ.0) CALL STVAL +C +CCCCCC DO WE HAVE TO ASK FOR PARAMETERS? + CALL SSWTCH(1,I) + IF (I.EQ.1) CALL GETCFG +C +CCCCCC OUTPUT SETTINGS? + CALL SSWTCH(2,I) + IF(I.EQ.2) CALL OUTCFG +C + WRITE (1,55) + 55 FORMAT (1H0) +C + CALL CALC2 +C + WRITE(1, 60) + 60 FORMAT (5HREADY) +C + PAUSE 7 + GO TO 110 + END +C END OF MAIN PROGRAM +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCC THE MANDELBROT SET CALCULATION + SUBROUTINE CALC2 +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + REAL CMPAVL + REAL ZR,ZI,ZRN + REAL X,Y + INTEGER COUNT +C +CCCCCC ENTER THE CALCULATION + 299 CMPVAL=MAXVAL*MAXVAL + X=LOWX + Y=HIGHY +C +CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT + 300 COUNT=0 + ZR=0.0 + ZI=0.0 +C +CCCCCC HIER DER ITERIERTE TEIL +C + 400 ZRN=ZR*ZR-ZI*ZI+X + ZI=2.0*ZR*ZI+Y + ZR=ZRN +C + IF ((ZR*ZR+ZI*ZI).GE.CMPVAL) GO TO 410 + COUNT=COUNT+1 + IF (COUNT.GE.MAXI) GO TO 410 + GO TO 400 +C +CCCCCC PUNKT FERTIG + 410 IF (COUNT.EQ.MAXI) CALL BLACK + IF (COUNT.LT.MAXI) CALL WHITE +CCCCCC NEUEN PUNKT MACHEN + 500 X = X + XSTEP +CCCCCC ZEILE NOCH NICHT VOLL? + IF (X.LE.HIGHX) GO TO 300 +CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN + X = LOWX + CALL PLOTR +C +C +CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN + Y=Y-YSTEP + IF (Y.GE.LOWY) GO TO 300 +C +CCCCCC HIER IST DAS BILD FERTIG. + RETURN + END +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + SUBROUTINE PLOTI + INTEGER PEN,PENX + COMMON /PENSTA/PEN,PENX + CALL PL$UP + PEN=0 + PENX=0 + RETURN + END +C + SUBROUTINE BLACK + INTEGER PEN,PENX + COMMON /PENSTA/PEN,PENX + IF (PEN.EQ.0) CALL PL$PD + PEN=1 + CALL PL$R + PENX=PENX+1 + RETURN + END +C + SUBROUTINE WHITE + INTEGER PEN,PENX + COMMON /PENSTA/PEN,PENX + IF (PEN.EQ.1) CALL PL$PU + PEN=0 + CALL PL$R + PENX=PENX+1 + RETURN + END +C + SUBROUTINE PLOTR + INTEGER PEN,PENX + COMMON /PENSTA/PEN,PENX + CALL WHITE + 8000 IF (PENX.EQ.0) GO TO 8100 + CALL PL$L + PENX=PENX-1 + GO TO 8000 + 8100 CONTINUE + CALL PL$DN + RETURN + END +C +CCCCCC STARTWERTE AUSFUELLEN + SUBROUTINE STVAL +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + INTEGER INIT + COMMON /PARAM3/INIT +C + CR = 13 + LF = 10 + WIDTH = 500 + MAXI = 50 + MAXVAL = 2.0 + LOWX =-1.48 + HIGHX = 0.5 + LOWY =-1.2 + HIGHY = 1.2 + INIT = 1 +C +CCCCCC SCHRITTWEITEN AUSRECHNEN + XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH) + YSTEP = XSTEP +C + WRITE (1,1500) + 1500 FORMAT (20HDEFAULT VALUES USED.) + RETURN + END +C +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCC EINSTELLUNGEN EINLESEN + SUBROUTINE GETCFG +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP +C + REAL XIN1,XIN2,YIN1,YIN2 +C + WRITE(1,11) + READ (1,16) XIN1 + WRITE(1,12) + READ (1,16) XIN2 + WRITE(1,13) + READ (1,16) YIN1 + WRITE(1,14) + READ (1,16) YIN2 + WRITE(1,15) + READ (1,17) MAXI +C + 11 FORMAT(14H X FROM : ) + 12 FORMAT(14H TO : ) + 13 FORMAT(14H Y FROM : ) + 14 FORMAT(14H TO : ) + 15 FORMAT(14H MAXIT (I3): ) + 16 FORMAT(F12.0) + 17 FORMAT(I3) +C +CCCCCC EVENTUELL STARTWERTE TAUSCHEN: +CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN + 150 I F(XIN2.GT.XIN1) GO TO 200 + TEMP = XIN1 + XIN1 = XIN2 + XIN2 = TEMP +C +CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN + 200 IF(YIN2.GT.YIN1) GO TO 201 + TEMP = YIN1 + YIN1 = YIN2 + YIN2 = TEMP +C +CCCCCC WERTE UEBERNEHMEN + 201 LOWX = XIN1 + HIGHX = XIN2 + LOWY = YIN1 + HIGHY = YIN2 +C +CCCCCC SCHRITTWEITEN AUSRECHNEN + XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH) + YSTEP = 2.0 * XSTEP +C + RETURN + END +C +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCC EINSTELLUNGEN AUSGEBEN + SUBROUTINE OUTCFG +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP +C + WRITE (1,20) + 20 FORMAT (9HSETTINGS:) + WRITE (1,30) LOWX, HIGHX + 30 FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5) + WRITE (1,40) LOWY, HIGHY + 40 FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5) + WRITE (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH + 50 FORMAT ( 4HMAX:,I3, + + 8H MAXVAL:,F8.5, + + 7H XSTEP:,F8.5, + + 7H YSTEP:,F8.5, + + 7H WIDTH:,I2) + RETURN + END +C +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCC RUECKSETZEN + SUBROUTINE RST +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF +C + WRITE(1,245) + 245 FORMAT(25HPARAMETER RESET REQUESTED) + INIT=0 + RETURN + END +C +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +C PRELOAD VALUE OF INIT + BLOCK DATA + INTEGER INIT + COMMON /PARAM3/INIT + DATA INIT/0/ + END +CCCCCCCCCCCCCCCCCCCCCCCC +$0 diff --git a/programs/plotter/src/plotapfel2.f b/programs/plotter/src/plotapfel2.f new file mode 100644 index 0000000..95aae1e --- /dev/null +++ b/programs/plotter/src/plotapfel2.f @@ -0,0 +1,290 @@ +C APFELMAENNCHEN-PROGRAMM, 06.FEBRUARY.2007 PHILIPP HACHTMANN +C INTERMEDIATE VERSION +C +C THIS VERSION SHOULD RUN A BIT FASTER BECAUSE THE SQUARE +C ROOT IS OMMITTED. +C +C SWITCH SETTINGS: +C SENSE-SWITCH 1: IF SET, ASK FOR PARAMETERS +C SENSE-SWITCH 2: IF SET, DON'T PRINT PARAMETERS ON START +C SENSE-SWITCH 3: IF SET, RESTORE PARAMETERS TO DEFAULT VALUES +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +C COMMON BLOCK DECLARATIONS +C + INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA + COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA +C + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP +C + INTEGER INIT + COMMON /PARAM3/INIT +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +C CONFIGURATION +CCCCCC RESET DO DEFAULT VALUES? + 110 CALL SSWTCH(3,I) + IF (I.EQ.1) CALL RST +C +CCCCCC ON THE FIRST START OR IF DESIRED + IF(INIT.EQ.0) CALL STVAL +C +CCCCCC DO WE HAVE TO ASK FOR PARAMETERS? + CALL SSWTCH(1,I) + IF (I.EQ.1) CALL GETCFG +C +CCCCCC OUTPUT SETTINGS? + CALL SSWTCH(2,I) + IF(I.EQ.2) CALL OUTCFG +C + WRITE (1,55) + 55 FORMAT (1H0) +C + CALL CALC2 +C + WRITE(1, 60) + 60 FORMAT (5HREADY) +C + PAUSE 7 + GO TO 110 + END +C END OF MAIN PROGRAM +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCC THE MANDELBROT SET CALCULATION + SUBROUTINE CALC2 +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + REAL CMPAVL + REAL ZR,ZI,ZRN + REAL X,Y + INTEGER COUNT +C +CCCCCC ENTER THE CALCULATION + 299 CMPVAL=MAXVAL*MAXVAL + X=LOWX + Y=HIGHY +C +CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT + 300 COUNT=0 + ZR=0.0 + ZI=0.0 +C +CCCCCC HIER DER ITERIERTE TEIL +C + 400 ZRN=ZR*ZR-ZI*ZI+X + ZI=2.0*ZR*ZI+Y + ZR=ZRN +C + IF ((ZR*ZR+ZI*ZI).GE.CMPVAL) GO TO 410 + COUNT=COUNT+1 + IF (COUNT.GE.MAXI) GO TO 410 + GO TO 400 +C +CCCCCC PUNKT FERTIG + 410 IF (COUNT.EQ.MAXI) CALL BLACK + IF (COUNT.LT.MAXI) CALL WHITE +CCCCCC NEUEN PUNKT MACHEN + 500 X = X + XSTEP +CCCCCC ZEILE NOCH NICHT VOLL? + IF (X.LE.HIGHX) GO TO 300 +CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN + X = LOWX + CALL PLOTR +C +C +CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN + Y=Y-YSTEP + IF (Y.GE.LOWY) GO TO 300 +C +CCCCCC HIER IST DAS BILD FERTIG. + RETURN + END +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + SUBROUTINE PLOTI + INTEGER PEN,PENX + COMMON /PENSTA/PEN,PENX + CALL PL$UP + PEN=0 + PENX=0 + RETURN + END +C + SUBROUTINE BLACK + INTEGER PEN,PENX + COMMON /PENSTA/PEN,PENX + CALL PL$R + IF (PEN.EQ.0) CALL PL$PD + PEN=1 + CALL PL$UP + CALL PL$R + CALL PL$DN + PENX=PENX+2 + RETURN + END +C + SUBROUTINE WHITE + INTEGER PEN,PENX + COMMON /PENSTA/PEN,PENX + IF (PEN.EQ.1) CALL PL$PU + PEN=0 + CALL PL$R + CALL PL$R + PENX=PENX+2 + RETURN + END +C + SUBROUTINE PLOTR + INTEGER PEN,PENX + COMMON /PENSTA/PEN,PENX + CALL WHITE + 8000 IF (PENX.EQ.0) GO TO 8100 + CALL PL$L + PENX=PENX-1 + GO TO 8000 + 8100 CONTINUE + CALL PL$DN + CALL PL$DN + RETURN + END +C +CCCCCC STARTWERTE AUSFUELLEN + SUBROUTINE STVAL +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + INTEGER INIT + COMMON /PARAM3/INIT +C + CR = 13 + LF = 10 + WIDTH = 100 + MAXI = 50 + MAXVAL = 2.0 + LOWX =-1.48 + HIGHX = 0.5 + LOWY =-1.2 + HIGHY = 1.2 + INIT = 1 +C +CCCCCC SCHRITTWEITEN AUSRECHNEN + XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH) + YSTEP = XSTEP +C + WRITE (1,1500) + 1500 FORMAT (20HDEFAULT VALUES USED.) + RETURN + END +C +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCC EINSTELLUNGEN EINLESEN + SUBROUTINE GETCFG +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP +C + REAL XIN1,XIN2,YIN1,YIN2 +C + WRITE(1,11) + READ (1,16) XIN1 + WRITE(1,12) + READ (1,16) XIN2 + WRITE(1,13) + READ (1,16) YIN1 + WRITE(1,14) + READ (1,16) YIN2 + WRITE(1,15) + READ (1,17) MAXI +C + 11 FORMAT(14H X FROM : ) + 12 FORMAT(14H TO : ) + 13 FORMAT(14H Y FROM : ) + 14 FORMAT(14H TO : ) + 15 FORMAT(14H MAXIT (I3): ) + 16 FORMAT(F12.0) + 17 FORMAT(I3) +C +CCCCCC EVENTUELL STARTWERTE TAUSCHEN: +CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN + 150 I F(XIN2.GT.XIN1) GO TO 200 + TEMP = XIN1 + XIN1 = XIN2 + XIN2 = TEMP +C +CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN + 200 IF(YIN2.GT.YIN1) GO TO 201 + TEMP = YIN1 + YIN1 = YIN2 + YIN2 = TEMP +C +CCCCCC WERTE UEBERNEHMEN + 201 LOWX = XIN1 + HIGHX = XIN2 + LOWY = YIN1 + HIGHY = YIN2 +C +CCCCCC SCHRITTWEITEN AUSRECHNEN + XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH) + YSTEP = 2.0 * XSTEP +C + RETURN + END +C +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCC EINSTELLUNGEN AUSGEBEN + SUBROUTINE OUTCFG +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF + REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP + COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP +C + WRITE (1,20) + 20 FORMAT (9HSETTINGS:) + WRITE (1,30) LOWX, HIGHX + 30 FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5) + WRITE (1,40) LOWY, HIGHY + 40 FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5) + WRITE (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH + 50 FORMAT ( 4HMAX:,I3, + + 8H MAXVAL:,F8.5, + + 7H XSTEP:,F8.5, + + 7H YSTEP:,F8.5, + + 7H WIDTH:,I2) + RETURN + END +C +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCC RUECKSETZEN + SUBROUTINE RST +C + INTEGER MAXI,WIDTH,CR,LF + COMMON /PARAM2/MAXI,WIDTH,CR,LF +C + WRITE(1,245) + 245 FORMAT(25HPARAMETER RESET REQUESTED) + INIT=0 + RETURN + END +C +C +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +C PRELOAD VALUE OF INIT + BLOCK DATA + INTEGER INIT + COMMON /PARAM3/INIT + DATA INIT/0/ + END +CCCCCCCCCCCCCCCCCCCCCCCC +$0 diff --git a/programs/plotter/src/plottest.f b/programs/plotter/src/plottest.f new file mode 100644 index 0000000..a732458 --- /dev/null +++ b/programs/plotter/src/plottest.f @@ -0,0 +1,59 @@ +C PLOTTER TEST PROGRAM +C +C +C + 1000 WRITE (1,1001) + 1001 FORMAT (13HPLOTTER TEST!) +C + 1005 DO 6000 J=1,300 +C + 1010 CALL PL$U + 1011 CALL PL$U + 1050 CALL PL$PD +C + 1100 DO 2000 I=1,50 + 1200 CALL PL$R + 2000 CONTINUE +C + 2050 CALL PL$PU + 2100 CALL PL$U + 2150 CALL PL$U + 2170 CALL PL$PD +C + 2200 DO 3000 N=1,50 + 2300 CALL PL$L + 3000 CONTINUE +C + 3100 CALL PL$PU +C + 6000 CONTINUE +CCCCCCCCCC +CCCCCCCCCC +11005 DO 16000 J=1,10 +C +11010 CALL PL$R +11011 CALL PL$R +11050 CALL PL$PD +C +11100 DO 12000 I=1,40 +11200 CALL PL$D +12000 CONTINUE +C +12050 CALL PL$PU +12100 CALL PL$R +12150 CALL PL$R +12170 CALL PL$PD +C +12200 DO 13000 N=1,40 +12300 CALL PL$U +13000 CONTINUE +C +13100 CALL PL$PU +C +16000 CONTINUE +C + 6500 CALL REBOOT + 6600 GO TO 1005 +C + 7000 END +$0 diff --git a/programs/plotter/src/plottest2.f b/programs/plotter/src/plottest2.f new file mode 100644 index 0000000..9a45c5e --- /dev/null +++ b/programs/plotter/src/plottest2.f @@ -0,0 +1,38 @@ +C PLOTTER TEST PROGRAM +C +C + CALL PL$RST + + CALL PL$PD + CALL PL$MV(610,0) + CALL PL$MV(610,95) + CALL PL$MV(0,95) + CALL PL$MV(0,0) + CALL PL$MV(1,1) + CALL PL$MV(609,1) + CALL PL$MV(609,94) + CALL PL$MV(1,94) + CALL PL$MV(1,1) + CALL PL$PU + CALL PL$MV(10,10) + + DO 1000 I=1,10 + CALL PL$RST + CALL PL$PD + CALL PL$MV(0,50) + CALL PL$MV(25,75) + CALL PL$MV(50,50) + CALL PL$MV(0,50) + CALL PL$MV(50,0) + CALL PL$MV(50,50) + CALL PL$MV(0,0) + CALL PL$MV(50,0) + CALL PL$PU + CALL PL$MV(60,0) + 1000 CONTINUE + CALL PL$MV(-540,-10) +C +C +10000 CALL REBOOT + END +$0 diff --git a/programs/plotter/src/stern.f b/programs/plotter/src/stern.f new file mode 100644 index 0000000..efc9c4d --- /dev/null +++ b/programs/plotter/src/stern.f @@ -0,0 +1,29 @@ +C PLOTTER TEST PROGRAM +C + INTEGER PHI + REAL PHIR + INTEGER XI,YI +C +C + 1000 CALL PL$RST +C +C + DO 2000 PHI=0,360,15 + CALL PL$MV(0,0) + PHIR=PHI + X=COS(PHIR)*100.0 + Y=SIN(PHIR)*100.0 + XI=X + YI=Y + CALL PL$PD + CALL PL$MV(XI,YI) + CALL PL$PU + 2000 CONTINUE + CALL PL$MV(0,0) + +C +C +10000 CALL REBOOT + END +$0 + diff --git a/simh/boot.do b/simh/boot.do new file mode 100644 index 0000000..cb40e1b --- /dev/null +++ b/simh/boot.do @@ -0,0 +1,8 @@ +at ptp /dev/lp0 +d p 37000 +d a 1000 +go +d a 100 +go +d a 37577 +go diff --git a/simh/slst.do b/simh/slst.do new file mode 100644 index 0000000..7785fcd --- /dev/null +++ b/simh/slst.do @@ -0,0 +1,12 @@ +! rm out.slst +at ptp out.slst + +r +d p 37000 +d a 1000 +go + +d a 100 +go +d a 36777 +go -- 2.32.0