Jump to content
IGNORED

TI 99/4A interfacing


Vorticon

Recommended Posts

I need to compare it to the Bresenham algorithm. Although recursion is pretty cheap in Forth it ain't free.

 

Take a look at my fbForth 2.0 primitive for LINE in bitmap graphics mode, which uses an integer, no-divide version of the Bresenham line algorithm:

 

 

;[*** LINE ***       ( x1 y1 x2 y2 --- )     ( alternative LINE---one or the other)
*++ This is an integer, no-divide version of the Bresenham line algorithm

* LINE does the following:
*     1) Computes dy = y2-y1 and dx =  x2-x1
*     2) Determines which direction, x or y, has slope <= 1
*         x) Flips dx and dy
*         y) Leaves dx and dy alone
*     3) sets DOTCNT = dx in R4
*     4) Computes D = 2*dy-dx
*     5) Forces plotting direction to be positive for independent variable
*     6) Sets starting y|x accumulator as acc = (y|x)
*     7) Finds accumulator increment as inc = +1|-1
*      Plots first dot
*     9) Each time through dot plotting loop:
*         a) Loop counter check
*         b) x|y = x|y + 1
*         c) D > 0?
*             yes)
*                 y1) acc = acc + inc
*                 y2) D = D+2*(dy-dx)
*             no) D = D+2*dy
*         d) y|x = acc
*         e) Plot dot
*         f) Decrement point counter

*        DATA DTBM_N
* LINE_N DATA 4+TERMBT*LSHFT8+'L','IN','E '+TERMBT
* LINE   DATA $+2
*        BL   @BLF2A
*        DATA _LINE->6000+BANK1

* Register usage---
*       R0:  varies
*       R1:  varies
*       R2:  y2
*       R3:  x2
*       R4:  y1, then, point (dot) count for line (DOTCNT)
*       R5:  x1, then, increment for dependent coordinate (INC) (+1|-1)
*       R6:  accumulator for dependent coordinate (ACC)
*       R7:  current independent coordinate       (COORD)
*       R8:  dx, then, 2*dx
*       R9:  dy, then, 2*dy
*      R10:  sign of dy/dx or dx/dy, then, D
*      R12:  contains flag for principal axis (1 = x axis, 0 = y axis)

_LINE  LIMI 0               ; disable interrupts because __DTBM doesn't
STPTR  EQU  MAINWS+18       ; stack pointer (fbForth's R9)
       LWPI FAC             ; let's use our ws
       MOV  @STPTR,R0       ; get stack pointer to R0
       MOV  *R0+,R2         ; pop coordinates (won't actually change Forth SP)
       MOV  *R0+,R3
       MOV  *R0+,R4
       MOV  *R0+,R5
       SETO R10             ; initially, store -1 as sign of slope
       MOV  R2,R0           ; calculate dy
       S    R4,R0
       MOV  R0,R1           ; prepare for sign calculation
       ABS  R0
       MOV  R0,R9
       MOV  R3,R0           ; calculate dx
       S    R5,R0
       XOR  R0,R1           ; calculate sign of slope (dy/dx|dx/dy)
       JLT  LINE01          ; negative slope?
       NEG  R10             ; change sign to +1
LINE01 ABS  R0
       MOV  R0,R8
       MOV  R9,R1
       C    R1,R0           ; compare|dy| to |dx|
       JLT  LINE04          ; dy < dx?
       MOV  R0,R9           ; no, flip dy
       MOV  R1,R8           ;        and dx
       MOV  R4,R7           ; assume starting with y1
       MOV  R5,R6           ;   and x1 (to ACC)
       C    R4,R2           ; should we switch?
       JGT  LINE02          ; yes
       JMP  LINE03          ; no
LINE02 MOV  R2,R7           ; we're starting with y2
       MOV  R3,R6           ;   and x2 (to ACC)
LINE03 CLR  CRU             ; 0 to CRU (R12) to indicate y-axis processing
       JMP  LINE07
LINE04 MOV  R5,R7           ; assume starting with x1
       MOV  R4,R6           ;   and y1 (to ACC)
       C    R5,R3           ; should we switch?
       JGT  LINE05          ; yes
       JMP  LINE06          ; no
LINE05 MOV  R3,R7           ; we're starting with x2
       MOV  R2,R6           ;   and y2 (to ACC)
LINE06 LI   CRU,1           ; 1 to CRU (R12) to indicate x-axis processing
LINE07 MOV  R10,R5          ; get sign to INC register before we destroy it!
       SLA  R9,1            ; dy = 2*dy (we don't need dy by itself any more)
       MOV  R9,R0           ; calculate D
       S    R8,R0           ; D = 2*dy-dx
       MOV  R0,R10          ; store D in DYXSN
       MOV  R8,R4           ; load point counter
       SLA  R8,1            ; 2*dx (we don't need dx by itself any more)
       MOV  CRU,CRU         ; x or y axis?
       JNE  LINE08          ; x-axis
       MOV  R7,R0           ; y-axis, COORD to y for DOT
       MOV  R6,R1           ; ACC to x for DOT
       JMP LNLOOP           ; to first plot
LINE08 MOV  R7,R1           ; x-axis, COORD to x for DOT
       MOV  R6,R0           ; ACC to y for DOT
LNLOOP BL   @__DTBM         ; plot first dot (R0 = y, R1 = x)
       MOV  R4,R4           ; are we done?
       JEQ  LINEX           ; yup!
       DEC  R4              ; decrement counter
       INC  R7              ; increment principal coordinate
*++ Calculate D
       MOV  R9,R1           ; get 2*dy
       MOV  R10,R0          ; D > 0?
       JGT  LINE09          ; yup
       JMP  LINE10          ; nope
LINE09 A    R5,R6           ; inc/dec dependent variable
       S    R8,R1           ; 2*dy-2*dx
LINE10 A    R1,R10          ; D = D+[2*dy or 2*dy-2*dx)]
       MOV  CRU,CRU         ; x-axis or y-axis?
       JEQ  LNYAX           ; y-axis
       MOV  R7,R1           ; x-axis, get next x for DOT
       MOV  R6,R0           ; get accumulator contents to y for DOT
       JMP  LNLOOP          ; go to plot
LNYAX  MOV  R7,R0           ; y-axis, get next y for DOT
       MOV  R6,R1           ; get accumulator contents to x for DOT
       JMP  LNLOOP          ; plot the dot (R0 = y, R1 = x) & on to next point
LINEX  LWPI MAINWS          ; RESTORE MAIN WS
       AI   SP,8            ; REDUCE STACK BY 4 CELLS
       B    @RTNEXT         ; back to bank 0 and the inner interpreter
;] 

 

 

As I recall, I had a fair amount of help from @Tursi on this. There is a fair discussion somewhere in the fbForth thread (see below in my signature) at the time I was converting all of the graphics primitives from TI Forth to ALC for fbForth 2.0 before I first released the cartridge a few years ago. You should have all of the source code. The graphics primitives are in Bank 1 file, fbForth104_GraphicsPrimitives.a99.

 

...lee

  • Like 1
Link to comment
Share on other sites

Wow!. What a gold mine. I need to get into Graphics II mode as well to have a test platform for the plotter.

 

You are THE man.

 

Thanks

 

You are more than welcome.

 

Besides straight-up Graphics2 mode, fbForth 2.0 (and TI Forth before it) has two hybrid modes that have bitmap graphics for part of the screen and text for the remainder:

  • Split mode has bitmap graphics in the top 2/3 of the screen and 8 lines of text in the bottom 1/3. This is used for the 64-column editor.
  • Split2 mode has 4 lines of text in the top 1/6 of the screen and bitmap graphics in the bottom 5/6.

The split modes are ideal for testing bitmap graphics coding.

 

...lee

Link to comment
Share on other sites

Yes I remember being very fond of the 64 column editor with the split screen. It was a windowed environment on a TI-99!

 

I will look into those split modes. For debugging it will be ideal for sure.

 

I found my old binder with my BLOCK listings and I wrote an Indexer way back then so It even has the index at the beginning. :)

 

I am going to use the Forth code as starting point see how far I get. These modes are foreign to me. Bit of a learning curve.

When I look at your ALC for DOT it's not obvious yet what's going on. More staring required.

Link to comment
Share on other sites

this probably belongs on a separate thread...

 

 

You are more than welcome.

 

Besides straight-up Graphics2 mode, fbForth 2.0 (and TI Forth before it) has two hybrid modes that have bitmap graphics for part of the screen and text for the remainder:

  • Split mode has bitmap graphics in the top 2/3 of the screen and 8 lines of text in the bottom 1/3. This is used for the 64-column editor.
  • Split2 mode has 4 lines of text in the top 1/6 of the screen and bitmap graphics in the bottom 5/6.

The split modes are ideal for testing bitmap graphics coding.

 

...lee

I don't remember split2! split was fascinating and caused me to ponder all the ways bitmap mode could be exploited.

 

I put a lot of effort into implementing a split mode with 18 rows of graphics and 6 rows of proportionally spaced bitmapped text (A/L library, not FORTH.) It squeezed about 42 characters on each line.

 

It computed a width table for patterns after loading CHARA1. It kept a 2 char (16 byte) working pattern buffer in ram, and each character to emit would be bit shifted and ORed with the buffer, which would be then be sent to VDP. When the right bytes were touched, the buffer would move the right char into the left and refresh.

 

It will be in my bag o stuff to show at CHI Friday.

  • Like 1
Link to comment
Share on other sites

I put together a test platform for myself for the Plotter control project and I realized that it could be a console for Vorticon's plotter control language.

It's not fancy but it let's me code some demos and get a solid platform upon which to build.

The sprite here will be simply following the progress of the plotter pen so it doesn't need to be too fast.

 

But even with this simple code the beauty of having a build-in interpreter can be demonstrated.

 

Here is the script that is interpreted as the BOXDEMO.

\ interpreting drawing commands
 CLEAR
\ size  y  x
\ ----------------
   10  20 20  BOX
   20  20 20  BOX
   30  20 20  BOX
   40  20 20  BOX
   50  20 20  BOX
   60  20 20  BOX
   70  20 20  BOX
   80  20 20  BOX
   90  20 20  BOX
  100  20 20  BOX
  110  20 20  BOX
  120  20 20  BOX

And here are the user API commands so far. They could be enhanced with more error checking but this is a first cut.

 

The plan is to get the turtle commands into the set as well.

 

And of course the commands will also need to have the plotter driver control added to them. That is not to tricky with concatenative languages.

: PEN-UP   ( -- )   1 CURSOR SP.COLOR ;
: PEN-DOWN ( -- ) RED CURSOR SP.COLOR ;
: MOVETO   ( y x -- ) PEN-UP   (X,Y) LINE .XY ;
: LINETO   ( y x -- ) PEN-DOWN (X,Y) LINE .XY ;
: HOME     ( -- ) 0 0 MOVETO ;
: RIGHT    ( n -- ) (X,Y)  >R +   0 255 CLIP  R>  LINETO ;
: LEFT     ( n -- ) NEGATE RIGHT ;
: DOWN     ( n -- ) (X,Y) ROT +  0 192 CLIP LINETO ;
: UP       ( n -- ) (X,Y) ROT -  0 192 CLIP LINETO ;

: BOX  ( size y x -- )
       DEPTH 3 < ABORT" BOX args"
       MOVETO
       DUP RIGHT
       DUP DOWN
       DUP LEFT
           UP
;

So when I have a something that I think can drive the plotter we can test the box demo as a first venture.

I have never done anything with graphics generation so I am in over my head but it's interesting.

plotterconsole.mp4

Edited by TheBF
Link to comment
Share on other sites

I put together a test platform for myself for the Plotter control project and I realized that it could be a console for Vorticon's plotter control language.

It's not fancy but it let's me code some demos and get a solid platform upon which to build.

The sprite here will be simply following the progress of the plotter pen so it doesn't need to be too fast.

 

But even with this simple code the beauty of having a build-in interpreter can be demonstrated.

 

Here is the script that is interpreted as the BOXDEMO.

\ interpreting drawing commands
 CLEAR
\ size  y  x
\ ----------------
   10  20 20  BOX
   20  20 20  BOX
   30  20 20  BOX
   40  20 20  BOX
   50  20 20  BOX
   60  20 20  BOX
   70  20 20  BOX
   80  20 20  BOX
   90  20 20  BOX
  100  20 20  BOX
  110  20 20  BOX
  120  20 20  BOX

And here are the user API commands so far. They could be enhanced with more error checking but this is a first cut.

 

The plan is to get the turtle commands into the set as well.

 

And of course the commands will also need to have the plotter driver control added to them. That is not to tricky with concatenative languages.

: PEN-UP   ( -- )   1 CURSOR SP.COLOR ;
: PEN-DOWN ( -- ) RED CURSOR SP.COLOR ;
: MOVETO   ( y x -- ) PEN-UP   (X,Y) LINE .XY ;
: LINETO   ( y x -- ) PEN-DOWN (X,Y) LINE .XY ;
: HOME     ( -- ) 0 0 MOVETO ;
: RIGHT    ( n -- ) (X,Y)  >R +   0 255 CLIP  R>  LINETO ;
: LEFT     ( n -- ) NEGATE RIGHT ;
: DOWN     ( n -- ) (X,Y) ROT +  0 192 CLIP LINETO ;
: UP       ( n -- ) (X,Y) ROT -  0 192 CLIP LINETO ;

: BOX  ( size y x -- )
       DEPTH 2 < ABORT" BOX args"
       MOVETO
       DUP RIGHT
       DUP DOWN
       DUP LEFT
           UP
;

So when I have a something that I think can drive the plotter we can test the box demo as a first venture.

I have never done anything with graphics generation so I am in over my head but it's interesting.

 

 

 

 

Nice! This is exactly what I was envisioning for the plotter control program in Forth.

  • Like 1
Link to comment
Share on other sites

Yes I remember being very fond of the 64 column editor with the split screen. It was a windowed environment on a TI-99!

 

I will look into those split modes. For debugging it will be ideal for sure.

 

I found my old binder with my BLOCK listings and I wrote an Indexer way back then so It even has the index at the beginning. :)

 

I am going to use the Forth code as starting point see how far I get. These modes are foreign to me. Bit of a learning curve.

When I look at your ALC for DOT it's not obvious yet what's going on. More staring required.

 

I used this split mode when I programmed Core War in TI Forth, the granddaddy of FbForth :)

 

https://youtu.be/pkjJCxK32tw

  • Like 1
Link to comment
Share on other sites

I got the mini LOGO words working with a sprite so that give me the rest of the hi-level platform.

This was written in Forth for a tiny machine and it used single letter names for things. So this is pretty big re-write, but I was grateful for the head start.

You can see the author working here: https://blogs.msdn.microsoft.com/ashleyf/2012/02/18/turtle-graphics-on-the-fignition/

 

It has a 6 degree resolution for angles from what I can understand ie: 15 TURN changes by 90 degrees, but it will be fine for a test platform.

 

I put some place holders in the code where the plotter control will go.

The spoiler has the code. The movie runs the demo.

 

1 step closer. I gotta stop for a while :-\

 

 

 

\ CAMEL99 FORTH LOGO using a Sprite Turtle to emulate the plotter
( Based on fignition LOGO. 
\ Expanded names from single letter commands for clarity

NEEDS DUMP    FROM DSK1.TOOLS      \ for debugging
NEEDS SPRITE  FROM DSK1.DIRSPRIT   \ loads GRAFIX also

\ ===============================================
\ define turtle graphic char
HEX
0000 1038 7CFE 0000 PATTERN: 0DEG

DECIMAL
\ turtle character
128 CONSTANT TURT0

\ ===============================================
\ define turtle characters for compass directions
  0DEG TURT0 CHARDEF

\ ===============================================
\ named colors
  2 CONSTANT BLK
  7 CONSTANT RED
  8 CONSTANT MAG  ( magenta)
 15 CONSTANT GRY
 16 CONSTANT WHT

: TEXTCOLOR  ( fg bg )  4 19 2SWAP COLORS  ;

\ ===============================================
\ screen coordinates
192 CONSTANT XMAX
255 CONSTANT YMAX

XMAX 2/ CONSTANT XCNTR
YMAX 2/ CONSTANT YCNTR

\ ===============================================
\ make the turtle sprite 
( char   colr  x y  sp# -- )
 TURT0   RED   0 0   0  SPRITE

\ state variables
 VARIABLE X      \ turtle x position
 VARIABLE Y      \ turtle y position
 VARIABLE ANGL   \ angle of direction
 VARIABLE Q      \ quadrature?
 VARIABLE W      \ Radian ?

\ ===============================================
\ direction table
DECIMAL
CREATE N      00 C, 027 C, 053 C, 079 C,
             104 C, 127 C, 150 C, 171 C,
             190 C, 206 C, 221 C, 233 C,
             243 C, 249 C, 254 C, 255 C,
              00 C,  ( needs final byte)

\ expose the table as a byte array. Use text macro for speed
: ]N@ ( ndx -- n) S" N + C@" EVALUATE ; IMMEDIATE

\ debug
\ : .TABLE   10 0 DO I ]N@ .  LOOP ;

DECIMAL
: >DIR ( angle -- coord)
       DUP>R  ABS >R
       R@ 15 MOD
       R@ 30 MOD 14 >
       IF 15 SWAP -
       THEN ]N@

       R@ 60 MOD 30 >
       IF NEGATE
       THEN RDROP RDROP ;

\ =======================================
\ coordinate scaling
: 256*     256 * ;       \ faster than 8 LSHIFT on CAMEL99
: 256/     8 RSHIFT ;

: XSCALE   256/ XCNTR +  ;
: YSCALE   256/ YCNTR +  ;

\ returns scaled,centred Y,X values
: [Y,X] ( -- y x) Y @ YSCALE  X @ XSCALE  ;

\ =======================================
\ plotter control  ( place holders for plotter control)
: PEN-UP             GRY 0 SP.COLOR ;
: PEN-DOWN           RED 0 SP.COLOR ;
: MOVE-PEN ( y x --) 0 LOCATE ;  ( raw plotter x,y position)

\ =======================================
\ FLOGO COMMANDS
: CLS     CLEAR  ;
: PLOT   ( y x -- )   MOVE-PEN  PEN-DOWN 10 MS PEN-UP  ;
: DRAW   ( -- )       PEN-DOWN  [Y,X] MOVE-PEN ;

: HEAD   ( angle -- ) DUP DUP ANGL !  >DIR Q !
                      45 + 60 MOD     >DIR W ! ;

: GOTO   ( x y -- )   PEN-UP  256* Y !  256* X ! [Y,X] MOVE-PEN ;
: HOME   ( -- )       PEN-UP   0 0 GOTO  0 HEAD ;
: MOV    ( n -- )     DUP Q @ * X +!   W @ * Y +!  DRAW ;

: TURN   ( angle -- ) ANGL +!  ANGL @ HEAD ;

: FWD  ( n -- )
         1 ?DO
             W @ Y +!
             Q @ X +!
             DRAW
         LOOP ;

: BGN    ( -- ) CLS  BLK SCREEN   HOME    GRY 1 TEXTCOLOR  PEN-UP  ;
: END    ( -- )  PEN-UP ." >" KEY DROP   MAG SCREEN   BLK 1 TEXTCOLOR  ;


\ =======================================
\ DEMO Programs
DECIMAL
: WALK     ( turns moves loops -- ) 
           0 ?DO   2DUP FWD TURN   LOOP 2DROP PEN-UP ;

: CIRCLE  ( -- ) 1 4 60 WALK ;
: SQUARE  ( -- ) 4 0 DO 50 FWD 15 TURN   LOOP  ;
: SPIRAL  ( -- ) 15 0 DO  CIRCLE 4 TURN  LOOP ;
: BURST   ( -- ) 60 0 DO 0 0 GOTO  I HEAD  110 FWD  LOOP ;
: STAR    ( -- ) 24 80 5 WALK ;
: STARS   ( -- ) 3 0 DO   STAR 20 TURN   LOOP ;
: SQUIRAL ( -- ) -50 50 GOTO  20 0 DO 100 FWD 21 TURN LOOP ;
: ROSE    ( -- ) 0 50 0 DO 2+ DUP FWD  14 TURN  LOOP ;
: HP      ( -- ) 1 5 15 WALK    -1 2 15 WALK ;
: PETAL   ( -- ) HP 30 TURN  HP 30 TURN  ;
: FLOWER  ( -- ) 15 0 DO   PETAL 4 TURN    LOOP ;
: WAIT    ( -- ) PEN-UP CLS ." Press a key..." KEY CLS BGN ;
: SINE    ( -- ) 160 0 DO I I >DIR 4 / 80 + PLOT LOOP ;

: DEMO
          BGN
           ." SIN wave"  SINE WAIT
           ." BURST"     BURST WAIT
           ." Squiral"   SQUIRAL WAIT
           ." Spiral"    SPIRAL WAIT
           ." Stars"     STARS WAIT
           ." Rose"      ROSE WAIT
           ." Flower"    FLOWER
          END ;

 

 

FLOGO.mp4

Edited by TheBF
  • Like 3
Link to comment
Share on other sites

  • 3 weeks later...
  • 2 weeks later...

So I started reverse engineering your new 1/2 step code to make a control lexicon in Forth for the plotter.

 

I get much of it but it's not 100% yet.

In the code below and in other places where you read the pointer variables like XPTR, why is it multiplied by 8? (SLA R2,3 )

 

Do you read the data in the tables from right to left for each byte?

* INITIALIZE X MOTOR ROUTINE
INITX  MOV  R11,@SUBRT3
       LI   R1,XPMDAT
       MOV  R1,@DATORG
       MOV  @XPTR,R2
       SLA  R2,3              * Why is the XPTR value multiplied by 8?
       A    R2,R1
       MOV  R1,@DATLOC
       LI   R1,>0400          SELECT X/Y CHIP
       MOV  R1,@SEL
       LI   R7,300            SET DELAY
       MOV  R7,@DELVAL
       MOV  @XPTR,R2
       MOV  @SUBRT3,R11
       B    *R11

To give you a taste of how this will work; to enable to the card, your label INITRS, I have a word >PIO.

What you label SHTDN is called PIO-CLOSE.

 

Here are the definitions for those routines written using other words created for this job.

: >PIO   ( -- )
         RS232#1 CARD    \ select the card
         LED-ON         
         'PIO OFF ;      \ reset PIO port to zero

: PIO-CLOSE ( -- ) >PIO  CARD-OFF  LED-OFF ;

The goal is to make it easy to use.

Link to comment
Share on other sites

XPTR is a pointer to the current active sequence of the X axis motor in the stepper motor activation sequence table at XPMDAT.

Each sequence is 8 bytes long, so we have to multiply XPTR by 8 in order to point to the beginning of the sequence data in the table.

 

At the Chicago pre-Faire gathering, Lee managed to simply point to the assembly driver from FbForth and directly access the routines like HOMEXY, PDOWN etc... without having to rework them in Forth. That's probably to most painless way to do it and it worked beautifully. Since you have already created a mini LOGO in Forth, I wonder if you could incorporate your code into his to get the plotter to plot the turtle movements directly.

 

Currently, once the blocks file is loaded, I can just type HOMEXY and the printer X and Y axes home in. PDOWN lowers the pen, PUP raises it, XRIGHT moves the X axes right 1 step etc... So basically fold these already defined primitives into your LOGO code and we've got a unique LOGO system!

Link to comment
Share on other sites

XPTR is a pointer to the current active sequence of the X axis motor in the stepper motor activation sequence table at XPMDAT.

Each sequence is 8 bytes long, so we have to multiply XPTR by 8 in order to point to the beginning of the sequence data in the table.

 

At the Chicago pre-Faire gathering, Lee managed to simply point to the assembly driver from FbForth and directly access the routines like HOMEXY, PDOWN etc... without having to rework them in Forth. That's probably to most painless way to do it and it worked beautifully. Since you have already created a mini LOGO in Forth, I wonder if you could incorporate your code into his to get the plotter to plot the turtle movements directly.

 

Currently, once the blocks file is loaded, I can just type HOMEXY and the printer X and Y axes home in. PDOWN lowers the pen, PUP raises it, XRIGHT moves the X axes right 1 step etc... So basically fold these already defined primitives into your LOGO code and we've got a unique LOGO system!

 

I'll post Lee's file when I get home tonight.

  • Like 1
Link to comment
Share on other sites

That sounds like that a quick way out the door for sure. I was considering just re-doing your ASM code in RPN asm but then I pulled up the schematic and the motor driver data sheet and I got all Forthy. :-)

 

So your code is data driven which is most common in conventional languages. But when I read the description of how you sequence the coils in a stepper motor,

I realized that was the language I needed to create to write the motor controller. I took the "code" sequence from the BLOG.

 

I have not tested any of this yet, but here an alternative way to code, replacing DATA with Forth words. (Edit: it now compiles)

 

All of this is the low level driver language to make the motors move. All I have to do now is write the high level words that you had in your DEF statements using this interface language.

 

Edit2: I already see problems with this but they are just about re-organizing the order of things in the motor sequencing. Ah well...

Edit3: I had forgotten that I had to activate 2 coils at once sometimes so this version corrects that. No attempt was made to make it tiny so it uses a about 1546 bytes.

However it replaces the ASM code and the Basic code so not too bad.

 

*NOT TESTED* on a PIO port.* ( Need to get one those cool db25 to terminal block thingies)

 

\ VORTICON Plotter driver in Camel99 Forth
\ December 2018

\ dependancies
NEEDS DUMP  FROM DSK1.TOOLS ( for debugging)

HERE
NEEDS SBZ   FROM DSK1.CRU

\ constants
HEX
5000 CONSTANT 'PIO          \ memory address of PIO port.
1300 CONSTANT RS232#1       \ CRU address of RS232 card

\ ********************************************************************
\  low level control words
: CARD-ON   ( -- )  0 SBO ;
: CARD-OFF  ( -- )  0 SBZ ;

: LED-ON    ( -- )  7 SBO ;
: LED-OFF   ( -- )  7 SBZ ;

: STROBE    ( -- )  2 SBO  2 SBZ ;  \ pulse CLOCK bit
: LATCH     ( -- )  3 SBO  3 SBZ ;  \ pulse LATCH bit

: PIO-O/P   ( -- )  1 SBZ ;         \ PIO output mode
: PIO-I/P   ( -- )  1 SBO ;         \ PIO input mode

: LIMIT?    ( -- ?) 2 TB  ;         \ true if limit switches closed

: DELAY ( n -- ) JIFFS ; \ N=1 ~= 16mS

\ ********************************************************************
\ CARD control words

\ Select a CARD in the PAB with cru address input parameter
\ Test for  1300 .. 1500 as valid
\ Test for previous CRU address and disable if not the same
: CARD  ( cru-addr -- )
         DUP 1300 1501 WITHIN 0= ABORT" Bad CARD address"
         DUP CRU@ <>     \ check R12 is the same
         IF    CARD-OFF  \ not the same, turn that card off
	 THEN  CRU!      \ then set new card as CRU base
	 CARD-ON ;       \ and turn new card on

\ enable PIO card
: >PIO   ( -- )
         RS232#1 CARD    \ select the card
         LED-ON          \ turn on the LED
         'PIO OFF ;      \ reset PIO port to zero

\ disable PIO card "CUT PIO"
: /PIO ( -- ) RS232#1 CARD   CARD-OFF  LED-OFF ; 

\ ********************************************************************
\ fundamental PIO read/write operations
: PIO-EMIT  ( byte -- ) PIO-O/P 'PIO C! ;
: PIO-GET   ( -- byte)  PIO-I/P 'PIO C@ ;

\ ********************************************************************
\                        *** MOTOR CONTROL ***

\ motor control bits
2 BASE !
01000000 CONSTANT X/Y        \ output enable IC1
00100000 CONSTANT PEN        \ output enable IC2
00000000 CONSTANT BIT0       \ PIO D7 OFF
10000000 CONSTANT BIT7       \ PIO D7 ON

DECIMAL
VARIABLE MTR 

\ select motor to use  ( X/Y or PEN )
: MOTOR ( n -- )  MTR ! ;        \ N =  X/Y or PEN

\ enable motor, pause, turn off
: STEP    ( -- ) MTR @ PIO-EMIT   2 DELAY   0 PIO-EMIT ;

: '0'   ( -- ) BIT0 PIO-EMIT STROBE ;  \ send a zero to shift register
: '1'   ( -- ) BIT7 PIO-EMIT STROBE ;  \ send 1 bit to shift register

: BIT-EMIT ( c -- ) 1 AND IF '1'  ELSE '0' THEN ; \ send 1 bit & clock

: SEND     ( c -- )
            8 0 DO
              DUP BIT-EMIT   \ send bits of 'c' via bit7 on PIO
              1 RSHIFT       \ get next bit
            LOOP
            DROP
            LATCH            \ Latch shift register
            STEP ;           \ Step motor(s) 1 time

\ Explanation:
\ The notation A+ here means that you run current through the A coil in
\ positive direction,with nothing in the B coil.
\ B- implies you've reversed the B coil with no current in the A coil.
\ motor coil control words

\ each 1 bit is one input to the L298 y axis Motor driver
2 BASE !
00001000 CONSTANT yA+
00000100 CONSTANT yA-
00000010 CONSTANT yB+
00000001 CONSTANT yB-

\ Each word below:
\ 1. sends Y bits by toggling D7 into the shift register
\ 2. latches the shift register
\ 3. enables the X/Y motor bit for 33mS
\ 4. turns off motor

DECIMAL
\ To run the motor in half steps, the sequence is like this:
: YFWD ( -- )
     X/Y MOTOR
     >PIO
        yA+        SEND
        yA+ yB+ OR SEND 
        yB+        SEND
        yB+ yA- OR SEND
        yA-        SEND
        yA- yB- OR SEND
        yB-        SEND
        yA+ yB- OR SEND
     /PIO ;

\ opposite of FWD
: YREV ( -- )
     X/Y MOTOR
     >PIO
        yB+        SEND
        yB+ yA+ OR SEND
        yA+        SEND
        yA+ yB- OR SEND
        yB-        SEND
        yB- yA- OR SEND
        yA-        SEND
        yA+ yB- OR SEND
     /PIO ;


\ each bit is one input to the L298 y axis & Pen Motor driver
2 BASE !
10000000 CONSTANT xA+
01000000 CONSTANT xA-
00100000 CONSTANT xB+
00010000 CONSTANT xB-

DECIMAL
: (FWD)   ( -- )  \ common factor for X fwd and pen fwd
      >PIO
        xA+        SEND
        xA+ xB+ OR SEND
        xB+        SEND
        xB+ xA- OR SEND
        xA-        SEND
        xA- xB- OR SEND
        xB-        SEND
        xA+ xB- OR SEND
      /PIO ;

 : (REV) ( -- )  \ common factor for X rev and pen rev
      >PIO
        xB+        SEND
        xB+ xA+ OR SEND
        xA+        SEND
        xA+ xB- OR SEND
        xB-        SEND
        xB- xA- OR SEND
        xA-        SEND
        xA+ xB- OR SEND 
      /PIO ;

: XFWD   ( -- )  X/Y MOTOR (FWD) ;
: XREV   ( -- )  X/Y MOTOR (REV) ;

: PENFWD ( -- )  PEN MOTOR (FWD) ;
: PENREV ( -- )  PEN MOTOR (REV) ;

\ ************************************************************
\ plotter control support words

VARIABLE WRITING     \ pen up/down tracking variable

: WRITING? ( -- ?) WRITING @ ;

: HOMEX
          LIMIT?         \ are we on the switch
          IF    XFWD     \ move off limit switch
          THEN           \ then reverse back until we hit limit
          BEGIN LIMIT? 0= WHILE  XREV  REPEAT ;

: HOMEY
          LIMIT?       \ are we on the switch
          IF    YFWD   \ move off limit switch
          THEN \ then reverse back until we hit limit
          BEGIN LIMIT? 0= WHILE  YREV  REPEAT ;
          
: TESTPEN   BEGIN LIMIT? 0= WHILE  PENREV REPEAT ;
          
: PENUP    20 0 DO  PENFWD LOOP   WRITING OFF ;
: PENDOWN  20 0 DO  PENREV LOOP   WRITING ON  ;

\ ************************************************************
\ HI LEVEL API
\ ************************************************************
: PUP      ( -- ) WRITING?    IF  PENUP   THEN ;
: PDOWN    ( -- ) WRITING? 0= IF  PENDOWN THEN ;

: HOMEXY   ( -- ) HOMEX HOMEY ;
: HOMEP    ( -- ) TESTPEN PENUP ;
: XRIGHT   ( -- ) 12 0 DO  XFWD  LOOP ;
: XLEFT    ( -- ) 12 0 DO  XREV  LOOP ;
: YUP      ( -- ) 12 0 DO  YFWD  LOOP ;
: YDOWN    ( -- ) 12 0 DO  YREV  LOOP ;

HERE SWAP - .  .( bytes)


Edited by TheBF
  • Like 3
Link to comment
Share on other sites

 

Currently, once the blocks file is loaded, I can just type HOMEXY and the printer X and Y axes home in. PDOWN lowers the pen, PUP raises it, XRIGHT moves the X axes right 1 step etc... So basically fold these already defined primitives into your LOGO code and we've got a unique LOGO system!

 

I'll post Lee's file when I get home tonight.

 

I will give that a whirl. I need to fully setup FBForth first. I don't have the block file easily accessible at the moment. Been meaning to do that.

 

If you have time, mount this disk or the contents, as dsk1 of your system and try out the code I wrote.

It will have bugs, but since you wrote code wars you could handle finding them easily I'm sure.

 

I set the delay in the motor on/off longer than yours in ASM code, so if you wanted to go faster just open the PLOTTER file in EDIT1 or your favourite TI programming editor and change the parameter for DELAY in the word STEP.

CAMEL99.zip

Link to comment
Share on other sites

I forgot to give you some instructions:

 

The system assumes support files are on DKS1.

 

E/A option 5: DSK1.CAMEL99

 

After the extensions load... type INCLUDE DSK1.PLOTTER

 

To see FORTH words type WORDS (FNCT 4 will stop the listing)

 

Your commands are available (maybe) :-0

: PUP      ( -- ) WRITING?    IF  PENUP   THEN ;
: PDOWN    ( -- ) WRITING? 0= IF  PENDOWN THEN ;

: HOMEXY   ( -- ) HOMEX HOMEY ;
: HOMEP    ( -- ) TESTPEN PENUP ;
: XRIGHT   ( -- ) 12 0 DO  XFWD  LOOP ;
: XLEFT    ( -- ) 12 0 DO  XREV  LOOP ;
: YUP      ( -- ) 12 0 DO  YFWD  LOOP ;
: YDOWN    ( -- ) 12 0 DO  YREV  LOOP ;
Edited by TheBF
  • Like 2
Link to comment
Share on other sites

You can remove those files no problem.

 

I just bundled up what I had.

The system only uses the files you can see listed in the START file:

DSK1.NEEDFROM

DSK1.INCLUDE

DSK1.CODE

DSK1.CELLS

DSK1.CHAR

 

and your program uses DSK1.TOOLS, DSK1.CRU and of course DSK1.PLOTTER.

 

Type COLD to reboot the system back to defaults.

 

Sorry for the inconvenience.

Edited by TheBF
Link to comment
Share on other sites

Looks like we need a little more trimming :) Could the PLOTTER file be located on DSK2?

 

You only need 8 files so remove anything else you want to. Remove ASM9900 and ANSFILES they are big.

 

SK1.NEEDFROM

DSK1.INCLUDE

DSK1.CODE

DSK1.CELLS

DSK1.CHAR

DSK1.TOOLS, DSK1.CRU DSK1.PLOTTER.

Link to comment
Share on other sites

I finally got a chance to test the Camel Forth program, and unfortunately it did not work. I have loaded all the files on one disk except for the ASM9900 and ANSFILES, so I don't think I'm missing anything here. I get a file error after the CHAR word is loaded. I am still able to continue afterwards but none of the plotter commands do anything. After I issue the first command, the cursor disappears although I am still able to type. I can see the RS232 card light come on and off with each command, so that part seems to be working at least :)

 

post-25753-0-50144800-1544443641_thumb.jpg

Link to comment
Share on other sites

OK. That's progress. The CHAR file seems to been corrupted. I saw that this weekend here and I saw the cursor disappear too.

I have only this weekend used this system on real iron for any length of time so you are something of an Alpha tester. (sorry)

 

I will wrap up a different ZIP file with the small file set for you and a hopefully a cursor too.

 

I have FBForth running on my PC but I have not integrated the LOGO examples yet. (got distracted by a serial port driver and...

some hospital time. (halidol levels were a little too low for a couple of patients on my mom's floor this weekend) :-0

Link to comment
Share on other sites

  • 1 year later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...