[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    {
    RE: Re: Virtual Reality.
    BY: Bas van Gaalen to John Shipley on Fri Mar 25 1994 02:26 pm

     > John Shipley wrote in a message to Bas van Gaalen:
     >
     >  > I posted it recently, so you must have seen it passing by...
     >  JS> You did? I read just about every post you write, I didn't
     >  JS> see any program by that name come by here.
     >
     > I suppose it got lost. You're the second... Anyway, I posted it again. Check
     > previous message... It should be there.

    Hello Bas!

    Yes, I got it today... basically the problem I saw with the code was lack of
    optimization and it also looked like you were trying to do too much. You
    didn't need all the asm. But it could be even faster if you included it. I'm
    sending back my modified version of your DYCP program. The "writecharasm"
    procedure was screwed up so I removed it and I will check it out at a later
    time. I modified the "writechar" procedure which you had commented out.

    -------8<---------Snip---------8<---------Snip---------8<--------Snip---------

    {$G+}
    PROGRAM different_y_char_position;

    (* Programmed by Bas van Gaalen, Holland, PD  *)
    (* Modified by John Shipley, USA, PD 03/30/94 *)

    USES CRT;

    CONST vseg : WORD   = $a000;
          txt  : STRING = '**** Well... 38 chars, let''s see. ****';
                       (*  12345678901234567890123456 78901234567890 *)
          txt1 : STRING = 'This is another Strng of 38 Characters';
    VAR stab      : ARRAY[0..255] OF BYTE;
        fseg,fofs : WORD;

    PROCEDURE getfont; ASSEMBLER;
      ASM
        mov ax,1130h;
        mov bh,1;
        int 10h;
        mov fseg,es;
        mov fofs,bp;
      END;

    PROCEDURE csin;
      VAR i : BYTE;
      BEGIN
        for i := 0 to 255 do stab[i] := round(sin(6*i*pi/255)*25)+40;(*150*)
      END;

    PROCEDURE clear(x,y: WORD); ASSEMBLER;
      ASM
        mov es,vseg
        mov dx,0
       @lout:
        mov cx,0
       @lin:
        mov ax,y
        add ax,dx
        shl ax,6
        mov di,ax
        shl ax,2
        add di,ax
        add di,x
        add di,cx
        xor ax,ax
        mov [es:di],ax
        add cx,2
        cmp cx,8
        jne @lin
        inc dx
        cmp dx,2 (* Was 8 *)
        jne @lout
      END;

    PROCEDURE writechar(ch: CHAR; x,y: WORD; col: BYTE);
      VAR j,k : BYTE;
          pre : WORD;
          opt : WORD;
      BEGIN
        pre := BYTE(ch)*8; (* Opt *)
        clear(x,y-2);      (* Key *)
        FOR j:=0 TO 7 DO
          FOR k:=0 TO 7 DO
            BEGIN
              opt := (y+j)*320+x+k;  (* Opt *)
              IF ((MEM[fseg:fofs+pre+j] SHL k) AND 128)=0 THEN
                MEM[$a000:opt] := 0 (* Key *)
              ELSE
                MEM[$a000:opt] := col;
            END;
        INC(y,8);   (* Opt *)
        clear(x,y); (* Key *)
      END;

    PROCEDURE dodycp;
      VAR sctr,i,l: BYTE;
          a,b,c : WORD;
      BEGIN
        sctr := 0;
        l := LENGTH(txt); (* Opt *)
        REPEAT
          WHILE (PORT[$3da] AND 8)<>0 DO;
          WHILE (PORT[$3da] AND 8)=0 DO;
          FOR i := 1 TO l DO
            BEGIN
              a := i*8;
              b := stab[(sctr+2*i) MOD 255];
              c := stab[sctr+i] MOD 64;
              INC(c,32);
              writechar(txt[i],a,b,c);
              INC(b,110);
              writechar(txt1[i],a,b,c);
            END;
          INC(sctr);
        UNTIL KEYPRESSED;
      END;

    BEGIN
      getfont;
      csin;
      ASM
        mov ax,13h;
        int 10h;
      END;
      dodycp;
      TEXTMODE(lastmode);
    END.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]