Announcement

Collapse
No announcement yet.

printf revisited

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • printf revisited

    Here is a printf subroutine that prints to the active window.
    It is slow. Some assembler is required but is beyond me.
    I started with some code that was posted by Dave Navarro and I
    added to it. I tend to use an SDK window as a console window and
    have routines to emulate the Basic PRINT, CLS, LOCATE etc. I
    bought PBCC but do not use it because of the console window's
    poor performance and my lack of control of the console window and
    its event loop. If I would have bought PBCC directly from
    Powerbasic I would have asked for my money back. The fact that
    there is a market for CONSOLE TOOLS speaks volumes. PBDLL should
    have been designed with its PRINT etc. commands in place.

    I came from a Mac background. There was a basic called Zbasic
    (now FutureBasic) which should be the model for this issue.
    I will get off my soap box now.


    '-------------------------------------------------------------------------------
    ' printf subroutine will print to the active window
    ' by Jim Klutho with code by Dave Navarro from Powerbasic forum
    ' Sept 12, 2001
    '-------------------------------------------------------------------------------

    #COMPILE EXE

    #INCLUDE "WIN32API.INC"
    DECLARE SUB printf CDECL (BYVAL f AS STRING [, ANY , ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY])

    '------------------------------------------------------------------------------

    FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
    BYVAL hPrevInstance AS LONG, _
    lpCmdLine AS ASCIIZ PTR, _
    BYVAL iCmdShow AS LONG) AS LONG

    LOCAL Msg AS tagMsg
    LOCAL wndclass AS WndClassEx
    LOCAL szAppName AS ASCIIZ * 80
    LOCAL hWnd AS LONG
    LOCAL hTemp AS LONG

    szAppName = "MyWin"

    wndclass.cbSize = SIZEOF(WndClass)
    wndclass.style = %CS_HREDRAW OR %CS_VREDRAW
    wndclass.lpfnWndProc = CODEPTR( WndProc )
    wndclass.cbClsExtra = 0
    wndclass.cbWndExtra = 0
    wndclass.hInstance = hInstance
    wndclass.hIcon = LoadIcon( hInstance, "HELLOWIN" )
    wndclass.hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW )
    wndclass.hbrBackground = GetStockObject( %WHITE_BRUSH )
    wndclass.lpszMenuName = %NULL
    wndclass.lpszClassName = VARPTR( szAppName )
    wndclass.hIconSm = LoadIcon( hInstance, BYVAL %IDI_APPLICATION )

    RegisterClassEx wndclass


    hWnd = CreateWindow(szAppName, _ ' window class name
    "Printf Test", _ ' window caption
    %WS_OVERLAPPEDWINDOW , _ ' window style
    %CW_USEDEFAULT, _ ' initial x position
    %CW_USEDEFAULT, _ ' initial y position
    %CW_USEDEFAULT, _ ' initial x size
    %CW_USEDEFAULT, _ ' initial y size
    %NULL, _ ' parent window handle
    %NULL, _ ' window menu handle
    hInstance, _ ' program instance handle
    BYVAL %NULL) ' creation parameters

    ShowWindow hWnd, iCmdShow

    hTemp=130
    printf "%@ Press F1 thru F5 - see code for explaination",hTemp

    WHILE GetMessage(Msg, %NULL, 0, 0)
    TranslateMessage Msg
    DispatchMessage Msg
    WEND

    FUNCTION = msg.wParam

    END FUNCTION ' WinMain

    '------------------------------------------------------------------------------

    FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
    BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG

    LOCAL x AS LONG
    LOCAL hTemp AS LONG
    LOCAL mydouble AS DOUBLE

    SELECT CASE wMsg

    CASE %WM_CREATE
    'Do nothing

    CASE %WM_KEYDOWN
    SELECT CASE wParam
    CASE %VK_F1 'Clear Screen
    printf "\c"

    CASE %VK_F2 'Print 100 lines
    FOR x=1 TO 100
    printf "Test line %l\n" , x
    NEXT x

    CASE %VK_F3 'Move to 10,20 and print line
    hTemp=1959
    printf "%@ Move to row 19 col 59", hTemp

    CASE %VK_F4 'Print successive lines
    printf "\cThis is"
    printf "a test string"

    CASE %VK_F5 'Formatted double on row 4 col 1
    mydouble=123.456789
    hTemp=401
    printf "\c %@ This is my formatted double %6.2d",hTemp,mydouble

    END SELECT
    hTemp=130
    printf "%@ Press F1 thru F5 - see code for explaination", hTemp
    FUNCTION = 0
    EXIT FUNCTION

    CASE %WM_DESTROY
    PostQuitMessage 0
    FUNCTION = 0
    EXIT FUNCTION

    END SELECT

    FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

    END FUNCTION

    SUB printf CDECL (BYVAL f AS STRING [, ANY , ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY])

    LOCAL x AS LONG
    LOCAL count AS LONG
    LOCAL p AS STRING PTR
    LOCAL s AS STRING PTR
    LOCAL b AS BYTE
    LOCAL t AS STRING
    LOCAL ps AS STRING
    LOCAL tlen AS STRING
    LOCAL prec AS STRING
    LOCAL formatstr AS STRING
    LOCAL myf AS SINGLE PTR
    LOCAL myi AS INTEGER PTR
    LOCAL myl AS LONG PTR
    LOCAL myd AS DOUBLE PTR
    LOCAL myb AS BYTE PTR
    LOCAL hWnd AS LONG
    LOCAL hDC AS LONG
    STATIC row AS LONG
    STATIC col AS LONG
    STATIC CurrentX AS LONG
    STATIC CurrentY AS LONG
    LOCAL itemp AS LONG
    LOCAL windowWidth AS LONG
    LOCAL windowHeight AS LONG
    LOCAL outstr AS ASCIIZ * 256
    LOCAL wndrect AS RECT
    LOCAL numrows AS LONG
    LOCAL numcols AS LONG
    LOCAL hFont AS LONG
    LOCAL hOldFont AS LONG
    LOCAL FontHeight AS LONG
    LOCAL FontWidth AS LONG
    LOCAL crColor AS LONG
    LOCAL clrbrush AS LONG
    LOCAL stat AS LONG


    hWnd=GetActiveWindow
    IF hWnd=0 THEN GOTO endprintf

    hDC = GetDC(hWnd)
    GetClientRect hWnd, wndrect
    hFont=GetStockObject(%OEM_FIXED_FONT) 'height 14 width 8
    FontHeight=14
    FontWidth=8
    hOldFont=SelectObject(hDC,hFont)
    numrows=wndrect.nBottom\FontHeight
    numcols=wndrect.nRight\FontWidth
    crColor=RGB(255,255,255) ' White
    clrbrush=CreateSolidBrush(crColor)

    IF CurrentY < 1 THEN CurrentY=1
    IF CurrentX < 1 THEN CurrentX=1

    p = VARPTR(f)

    FOR x = 1 TO LEN(f)
    b = ASC(f, x)
    IF b = 37 THEN
    INCR x
    b = ASC(f, x)
    IF ((b > 47 AND b < 58) OR b=46) THEN GOSUB printfprecision
    IF b = 37 THEN
    t = t & CHR$(b)

    ELSE
    p = p + 4
    SELECT CASE b

    CASE 100 'd float (double)
    myd=p
    IF LEN(formatstr)>0 THEN
    t = t & FORMAT$(@@myd,formatstr)
    ELSE
    t = t & FORMAT$(@@myd)
    END IF

    CASE 98 'b byte
    myb=p
    IF LEN(formatstr)>0 THEN
    t = t & FORMAT$(@@myb,formatstr)
    ELSE
    t = t & FORMAT$(@@myb)
    END IF

    CASE 102 'f float (single)
    myf=p
    IF LEN(formatstr)>0 THEN
    t = t & FORMAT$(@@myf,formatstr)
    ELSE
    t = t & FORMAT$(@@myf)
    END IF

    CASE 105 'i integer
    myi=p
    IF LEN(formatstr)>0 THEN
    t = t & FORMAT$(@@myi,formatstr)
    ELSE
    t = t & FORMAT$(@@myi)
    END IF

    CASE 108 'l long
    myl=p
    IF LEN(formatstr)> 0 THEN
    t = t & FORMAT$(@@myl,formatstr)
    ELSE
    t = t & FORMAT$(@@myl)
    END IF

    CASE 115 's string
    s = p
    IF LEN(formatstr)>0 THEN
    t = t & MID$(@@s,1,VAL(tlen))
    ELSE
    t = t & @@s
    END IF

    CASE 64 '@ moveto row col row is in hundreds example: row 19 and col 59 = 1959
    myl=p
    CurrentY=(@@myl)\100
    CurrentX=(@@myl) MOD 100
    END SELECT
    END IF '%
    ELSEIF b=92 THEN '\
    INCR x
    b = ASC(f, x)
    SELECT CASE b
    CASE 110 'n
    GOSUB printfprint
    INCR CurrentY
    CurrentX=1
    CASE 99 'c
    FillRect hDC,wndrect,clrbrush
    CurrentX=1
    CurrentY=1
    END SELECT
    ELSE
    t = t & CHR$(b)
    END IF
    NEXT

    IF LEN(t)> 0 THEN GOSUB printfprint
    GOTO endprintf

    printfprecision:
    formatstr=""
    ps=""
    WHILE ((b > 47 AND b < 58) OR b=46)
    ps=ps & CHR$(b)
    INCR x
    b = ASC(f, x)
    WEND
    count=INSTR(1,ps,".")
    IF count > 0 THEN
    tlen=MID$(ps,1,count-1)
    prec=MID$(ps,count+1)
    ELSE
    tlen=ps
    prec="0"
    END IF
    formatstr=STRING$(VAL(tlen),"#")
    IF count > 0 THEN
    IF LEN(prec)>0 THEN formatstr=formatstr +"."+ STRING$(VAL(prec),"#")
    END IF
    RETURN

    printfprint:
    itemp=LEN(t)
    outstr=t

    IF CurrentY > numrows THEN
    CurrentY = numrows
    stat= ScrollWindow (hWnd,0,-FontHeight,wndrect,wndrect)
    END IF

    ValidateRect hWnd, BYVAL %NULL
    col=CurrentX * FontWidth - 6
    row=CurrentY * FontHeight - 12
    CALL Textout(hDC,col,row,outstr,itemp)
    CurrentX = CurrentX + LEN(t)+1
    t=""
    RETURN

    endprintf:
    ReleaseDC hWnd, hDC
    hOldFont=SelectObject(hDC,hOldFont)
    DeleteObject hFont
    DeleteObject clrbrush
    END SUB






    ------------------

  • #2
    Originally posted by james klutho:
    Here is a printf subroutine that prints to the active window.
    It is slow. Some assembler is required but is beyond me.
    I started with some code that was posted by Dave Navarro and I
    added to it.
    James, what precisely is your question? Are you looking for someone to speed it up, or...?

    I bought PBCC but do not use it because of the console window's
    poor performance and my lack of control of the console window and
    its event loop.
    Console Windows, as designed by Microsoft, do not use a standard message pump and window callback arrangement.

    The fact that there is a market for CONSOLE TOOLS speaks volumes.
    I'm afraid I don't follow your logic here, sorry!

    PBDLL should have been designed with its PRINT etc. commands in place.
    Well, that would mean that PB/DLL would have been a console compiler rather than a GUI compiler. However, since you own PB/CC that is designed to natively create and use a console window, and offers PRINT, CLS, LOCATE, etc, you already have the tools available for console handling without the need to write your own handlers.

    However, if the speed of the PRINT statement in a Win9x console is a problem for you (note that NT does not suffer this problem because it's console sub-system does not have to thunk to 16-bit mode for any operations), then there are at least 4 ways to speed it up dramatically.

    The easiest way (which is my favorite) is to initially use PAGE 2,1, then after a bunch of PRINT statements, use PCOPY 2,1 to update the visible screen page from the active screen page.

    This is very easy to implement, and can be retrofitted extremely easily to existing code if there is a problem.

    I came from a Mac background. There was a basic called Zbasic
    (now FutureBasic) which should be the model for this issue.
    At a guess, I would say that that is not the model that PowerBASIC R&D want to use, or there would be only one PowerBASIC compiler for the 32-bit Windows platform.

    Please forgive my morbid curiousity, but since that combination was so successful for you, why did you abandon it?

    ------------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>
    Lance
    mailto:[email protected]

    Comment

    Working...
    X