Qbasicnews.com
April 25, 2019, 12:53:05 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: Your own Input routine...  (Read 3419 times)
Rokkuman
Na_th_an
*****
Posts: 1973



« on: July 12, 2003, 09:11:33 PM »

Thanks for telling me how to find out what files are in a folder, hopefully this will be the last of my series of questions for a while..

Could someone tell me how to make my own input routine, it sounded easy, but when I tried it myself, it ended in disaster (mainly with backspacing). Could someone give me an example please? Thanks...
Logged
Agamemnus
x/ \z
*****
Posts: 3491



« Reply #1 on: July 12, 2003, 09:23:40 PM »

Here's one I made for my never-released Star Commander game:

Starts at exactly the current print position. Use LOCATE if you like.

message$ = default output.
max.size% = max size of text.
n% = I don't know what it is. Just try 1 or 0, whichever doesn't crash first.

Code:

FUNCTION input2$ (message$, max.size%, n%)
msg.size% = LEN(message$)
IF max.size% < msg.size% THEN max.size% = msg.size% + 2
mark$ = " "
mark2$ = "_"
x1% = POS(0)
y1% = CSRLIN
timer2 = TIMER
i$ = SPACE$(n%)
DO

IF LEN(i$) = 1 THEN
i% = ASC(i$)
IF i% > 31 AND i% < 133 AND msg.size% < max.size% THEN message$ = message$ + i$: msg.size% = msg.size% + 1
IF i% = 27 THEN message$ = "": EXIT DO
IF i% = 13 THEN EXIT DO
IF i% = 8 AND msg.size% >= 1 THEN msg.size% = msg.size% - 1: message$ = LEFT$(message$, LEN(message$) - 1): mark3$ = " "
LOCATE y1%, x1%: PRINT message$ + mark$ + mark3$
END IF

DO
i$ = INKEY$: IF i$ <> "" THEN EXIT DO
IF timer2 + .5 < TIMER THEN timer2 = TIMER: SWAP mark$, mark2$: LOCATE y1%, x1% + msg.size%: PRINT mark$
LOOP

LOOP
input2$ = message$
END FUNCTION
Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
Rokkuman
Na_th_an
*****
Posts: 1973



« Reply #2 on: July 12, 2003, 10:51:12 PM »

Agamemnus... could you please tell me what code in there handles the backspace please?
Logged
pr0gger
I hold this place together
*****
Posts: 775


« Reply #3 on: July 12, 2003, 11:29:06 PM »

Code:
IF i% = 8 AND msg.size% >= 1 THEN msg.size% = msg.size% - 1: message$ = LEFT$(message$, LEN(message$) - 1): mark3$ = " "


This little thingie backspaces, since the backspace char is 8.
Logged

size=9]"To announce that there must be no criticism of the president, or that we are to stand by the president, right or wrong, is not only unpatriotic and servile, but is morally treasonable to the American public." -- Theodore Roosevelt[/size]
Rokkuman
Na_th_an
*****
Posts: 1973



« Reply #4 on: July 13, 2003, 01:42:45 AM »

Alright, last question... how do I get the varible to be taken from the input command?
Logged
toonski84
__/--\__
*****
Posts: 2567



« Reply #5 on: July 13, 2003, 02:00:44 AM »

it's a function, silly

theinput$ = input2$ (all those parameters)
Logged

i]"I know what you're thinking. Did he fire six shots or only five? Well, to tell you the truth, in all this excitement, I've kinda lost track myself. But being as this is a .44 Magnum ... you've got to ask yourself one question: 'Do I feel lucky?' Well, do ya punk?"[/i] - Dirty Harry
Rokkuman
Na_th_an
*****
Posts: 1973



« Reply #6 on: July 13, 2003, 02:04:57 AM »

A function? I never did know how to use those?

How am I supposed to make the whole "sub" be equal to what I want???

Edit: Figures it out..
Logged
relsoft
*/-\*
*****
Posts: 3927



WWW
« Reply #7 on: July 15, 2003, 04:15:15 AM »

Here. Handles backspace, insert, etc. ;*)

Code:


' This program Demonstrates a primitive TEXTBox written in qbasic 4.5
' Use this routine freely(although I'd be happy to see me credited :P)
' This program is written by Richard Eric M. Lope
' My Email: vic_viperph@yahoo.com

DECLARE FUNCTION GetString$ (Row%, Col%, Start$, End$, Vis%, Max%)
DEFINT A-Z

CONST False = 0, True = NOT False
CONST Enter = 13, Escape = 27, SpaceBar = 32, BackSpace = 8
CONST Right = 77, Left = 75, Down = 80, Up = 72
CONST Insert = 82, Delete = 83, Home = 71, EndKey = 79, PgUp = 73, PgDown = 81
CONST F1 = 59, F2 = 60, F3 = 61, F4 = 62, F5 = 63, F6 = 64, F7 = 65, F8 = 66


COLOR 5, 1

CLS
COLOR 14, 13
St$ = "Richard"
DO
A$ = GetString$(10, 20, St$, Ed$, 15, 35)
LOOP UNTIL A$ = CHR$(Enter)  '  OR A$ = CHR$(0) + CHR$(Down) OR A$ = CHR$(0) + CHR$(Up)
LOCATE 12, 20
PRINT Ed$, LEN(Ed$)


END

FUNCTION GetString$ (Row, Col, Start$, End$, Vis, Max)
'Notes:
'Row=Row to print the text
'Col=Column to print the text
'Starting=Sting(default) use "" for blank
'End$=The String to use(return)
'Vis=Visible field of text box
'Max=Maximum number of letters that end$ can have
'if max>vis then the string is scrolled

STATIC Insertmode
Word$ = RTRIM$(Start$)
IF Word$ = CHR$(BackSpace) OR Word$ = "  " THEN Word$ = ""
LOCATE , , 1

MaxP = LEN(Word$)

IF MaxP < Vis THEN
        P = MaxP
ELSE
        P = Vis
END IF

B = 1

                                IF Insertmode THEN
                                        LOCATE , , 1, 1, 7
                                ELSE
                                        LOCATE , , 1, 6, 7
                                END IF


Finished = False

DO
  GOSUB PrintWord
     DO: K$ = INKEY$: LOOP UNTIL K$ <> ""

        IF LEN(K$) = 2 THEN

                SELECT CASE ASC(RIGHT$(K$, 1))
                        CASE Right
                                IF P + B <= MaxP THEN
                                        IF P < Vis THEN
                                                P = P + 1
                                        ELSE
                                                IF B < (MaxP - Vis) + 1 THEN
                                                        B = B + 1
                                                ELSE
                                                        BEEP
                                                END IF
                                        END IF
                                ELSE
                                        BEEP
                                END IF
                        CASE Left
                                IF P > 0 THEN
                                        P = P - 1
                                ELSE
                                        IF B > 1 THEN
                                                B = B - 1
                                        ELSE
                                                BEEP
                                        END IF
                                END IF
                        CASE Insert
                                        Insertmode = NOT Insertmode
                                IF Insertmode THEN
                                        LOCATE , , 1, 1, 7
                                ELSE
                                        LOCATE , , 1, 6, 7
                                END IF
                        CASE Delete
                                IF MaxP > Vis THEN
                                        IF B + P <= MaxP THEN
                                                Word$ = LEFT$(Word$, (B + P) - 1) + RIGHT$(Word$, MaxP - (B + P))
                                                MaxP = MaxP - 1
                                        END IF
                                ELSE
                                        IF MaxP > 0 THEN
                                                IF P < MaxP THEN
                                                        Word$ = LEFT$(Word$, P) + RIGHT$(Word$, MaxP - P - 1)
                                                        MaxP = MaxP - 1
                                                ELSE
                                                        BEEP
                                                END IF
                                        ELSE
                                                BEEP
                                        END IF
                                END IF
                        CASE Up, Down
                                Finished = True
                                Word$ = Start$
                        CASE EndKey
                                        IF MaxP < Vis THEN
                                                B = 1
                                                P = MaxP
                                        ELSE
                                                B = (MaxP - Vis) + 1
                                                P = Vis
                                        END IF
                        CASE Home
                                P = 0
                                B = 1
                        CASE ELSE
                                BEEP
                END SELECT

        ELSE
                SELECT CASE ASC(K$)
                        CASE BackSpace
                                IF MaxP > Vis THEN
                                   IF P > 0 THEN
                                        Word$ = LEFT$(Word$, (B + P) - 2) + RIGHT$(Word$, MaxP - (B + P - 1))
                                        MaxP = MaxP - 1
                                                P = P - 1
                                                'IF B = (MaxP - Vis) + 1 AND P = 1 THEN B = B - 1
                                   ELSE                         'P=0
                                        IF B > 1 THEN
                                                Word$ = LEFT$(Word$, (B + P) - 2) + RIGHT$(Word$, MaxP - (B + P - 1))
                                                MaxP = MaxP - 1
                                                B = B - 1
                                                'IF B > MaxP THEN B = MaxP
                                        END IF
                                   END IF
                                                                        'MaxP=>Vis
                                ELSE
                                        IF P > 0 THEN
                                                Word$ = LEFT$(Word$, P - 1) + RIGHT$(Word$, MaxP - P)
                                                MaxP = MaxP - 1
                                                P = P - 1
                                        ELSE
                                                IF B > 1 THEN
                                                        Word$ = LEFT$(Word$, MaxP - 1)
                                                        B = B - 1
                                                        MaxP = MaxP - 1
                                                ELSE
                                                        BEEP
                                                END IF
                                        END IF
                                END IF

                        CASE Escape
                                Finished = True
                                Word$ = Start$
                        CASE Enter
                                Finished = True
                        CASE IS >= SpaceBar
                                IF Insertmode THEN
                                    IF MaxP < Vis THEN
                                        Word$ = LEFT$(Word$, P) + K$ + RIGHT$(Word$, MaxP - P)
                                        MaxP = MaxP + 1
                                        P = P + 1
                                    ELSE
                                        IF MaxP < Max THEN
                                          IF P < Vis THEN
                                                Word$ = LEFT$(Word$, (B + P - 1)) + K$ + RIGHT$(Word$, MaxP - (B + P - 1))
                                                MaxP = MaxP + 1
                                                P = P + 1
                                          ELSE
                                                IF B < (MaxP - Vis) + 1 THEN
                                                        Word$ = LEFT$(Word$, (B + P - 1)) + K$ + RIGHT$(Word$, MaxP - (B + P - 1))
                                                        MaxP = MaxP + 1
                                                        B = B + 1
                                                ELSE
                                                        Word$ = Word$ + K$
                                                        MaxP = MaxP + 1
                                                        B = B + 1

                                                END IF
                                          END IF
                                        END IF


                                    END IF

                                ELSE
                                    ' If overwrite mode and cursor at end (but not beyond),
                                    ' insert character.
                                    IF MaxP < Vis THEN
                                        IF P = MaxP THEN
                                                Word$ = Word$ + K$
                                                MaxP = MaxP + 1
                                                P = P + 1
                                        ELSE
                                                MID$(Word$, P + 1, 1) = K$
                                                P = P + 1
                                        END IF
                                    ELSE                                'MaxP=>Vis
                                        IF P < Vis THEN
                                                MID$(Word$, B + P, 1) = K$
                                                P = P + 1
                                        ELSE
                                             IF MaxP < Max THEN
                                                IF B < (MaxP - Vis) + 1 THEN
                                                        MID$(Word$, B + P, 1) = K$
                                                        B = B + 1
                                                ELSE
                                                        Word$ = Word$ + K$
                                                        MaxP = MaxP + 1
                                                        B = B + 1
                                                END IF
                                             END IF
                                        END IF
                                    END IF
                                END IF

                        CASE 1
                                ' do nothing
                        CASE ELSE
                                        BEEP
                END SELECT

        END IF

LOOP WHILE NOT Finished

End$ = Word$
GetString$ = K$

EXIT FUNCTION

PrintWord:
LOCATE Row, Col
IF MaxP < Vis THEN
        PRINT MID$(Word$, B, MaxP); SPACE$(Vis - MaxP); " "
        LOCATE Row, Col + P
ELSE
        PRINT MID$(Word$, B, Vis); " "
        LOCATE Row, Col + P
END IF

'\=======
LOCATE 21, 1
PRINT "Vis="; Vis, "MaxP="; MaxP, "P="; P, "B="; B;
LOCATE 22, 1
PRINT "Len="; LEN(Word$), "Word="; Word$ + " ";
LOCATE Row, Col + P

RETURN

END FUNCTION


Logged

y smiley is 24 bit.


Genso's Junkyard:
http://rel.betterwebber.com/
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #8 on: July 15, 2003, 05:11:41 AM »

Here is my input routine:
Code:

SUB TextIn (ui$, prompt$, cur, linelen)

' Substitutes LINE INPUT. By Antoni Gual  agual@eic.ictnet.es
' PARAMETERS:--------------------------------------------------------------
' ui$:    Returns user input.Can be initialized. Can't include color codes
' prompt$: Prompt string. Can include color codes in the form chr$(27)+chr$(background*16+foreground)
' cur:     It allows to initialize cursor position and returns the position
'            where cursor ended, or -1 if user aborted with ESC.
' linelen: Limits size of the prompt+user input window. If 0 it defaults to
'            screen width.
' FEATURES:----------------------------------------------------------------
' Allows input  to be aborted with ESC.
' Allows user input and cursor position to be initialized to not null
' Dos noes span to multi line. If input exceeds available space scrolls it!
' It interprets escape sequences in prompt as color codes
'   (The last color code in the prompt will apply to the input window..)
' It saves the active COLOR setting and restores it
'--------------------------------------------------------------------------
    col = POS(0)
    IF linelen > 81 - col OR linelen = 0 THEN linelen = 81 - col
   
    'save current active color to cfg, cbg
    LOCATE , col: PRINT " "; : LOCATE , col: clr = SCREEN(CSRLIN, POS(0), 1)
    cbg = clr / 16: cfg = clr MOD 16
   
    'parse colors in prompt and display it
    a1 = 1: lp = col + LEN(prompt$): e$ = CHR$(27)
    DO
      a = INSTR(a1, prompt$, e$)
      IF a THEN
          b = ASC(MID$(prompt$, a + 1, 1)): bg = b \ 16: fg = b MOD 16: lp = lp - 2
          PRINT MID$(prompt$, a1, a - a1); : COLOR fg, bg: a1 = a + 2
      END IF
    LOOP UNTIL a = 0 OR a1 > LEN(prompt$)
    PRINT MID$(prompt$, a1);
     
    'init
    txt$ = ui$
    lf = linelen - lp: c1$ = SPACE$(lf): ins = 1: topcur = 1: strt = 1
    IF cur = 0 OR cur > LEN(txt$) THEN cur = LEN(txt$) + 1
     
    'key input loop
    DO
   
        'display input string
        IF cur > lf + strt THEN strt = cur - lf + 1
        IF cur < strt THEN strt = cur
        kur = lp + cur - strt: LSET c1$ = MID$(txt$, strt)
        LOCATE , lp: PRINT c1$; : LOCATE , kur, 1, topcur, 16
           
        'get a key
        DO: k$ = INKEY$: LOOP UNTIL LEN(k$)
        ky = ASC(RIGHT$(k$, 1)): IF LEN(k$) = 2 THEN ky = -ky
           
        'modify txt$ on key read
        SELECT CASE ky
        CASE 32 TO 255
            IF cur > LEN(txt$) THEN
                txt$ = txt$ + CHR$(ky)
            ELSEIF cur = 1 THEN
                IF ins THEN txt$ = CHR$(ky) + MID$(txt$, cur) ELSE MID$(txt$, cur) = CHR$(ky)
            ELSE
                IF ins THEN
                    txt$ = LEFT$(txt$, cur - 1) + CHR$(ky) + MID$(txt$, cur)
                ELSE
                    MID$(txt$, cur) = CHR$(ky)
                END IF
            END IF
            cur = cur + 1
        CASE 8: IF cur > 1 THEN kur = cur - 1: GOSUB delete: cur = cur - 1
        CASE -83: IF cur <= LEN(txt$) THEN kur = cur: GOSUB delete
        CASE -75: IF cur > 1 THEN cur = cur - 1
        CASE -77: IF cur <= LEN(txt$) THEN cur = cur + 1
        CASE -82: ins = NOT ins: IF topcur = 1 THEN topcur = 16 ELSE topcur = 1
        CASE -71: cur = 1
        CASE -79: cur = LEN(txt$) + 1
        END SELECT

    LOOP UNTIL ky = 13 OR ky = 27
       
    PRINT
    IF ky = 27 THEN cur = -1 ELSE ui$ = txt$
    'reset original active color
    IF a THEN COLOR cfg, cbg
    EXIT SUB
delete: txt$ = LEFT$(txt$, kur - 1) + MID$(txt$, kur + 1): RETURN
END SUB
Logged

Antoni
Jark
Ancient Guru
****
Posts: 566



WWW
« Reply #9 on: July 15, 2003, 10:12:45 AM »

I was about to reprog an input function for the TC-Lib... Think I just have to cut&paste now!
Logged

hink Global, Make Symp' All !
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #10 on: July 15, 2003, 10:16:12 AM »

How is TCLib going?
Logged

Antoni
Jark
Ancient Guru
****
Posts: 566



WWW
« Reply #11 on: July 15, 2003, 10:45:45 AM »

I corrected a couple of bugs in the graphic basics (Line24 and Ellipse24) while programming TC-Draw...

I simplified the patterns coding (I used double coding in the subs until I realised I could do the same with a better test on Pattern% value).

I now have one .bi and one .bas, plan to make a .qlb when TC-Draw and TC-Mdb will be finalised.

The mouse is real fine now, I have dynamic contextual pointer changes, with a pen, a cross, a arrow, a rubber, etc...

I separated the raytracing modules from the core TC-Lib, and introduced TC-Ray on the Dazibao. The next project in raytracing is to switch from the basic normal projection (the one I used) to a genuine true vision, with a spheric projection and thus distance representation.

I also found the principle to calculate marble and wooden textures... I just miss time to do all that !
Logged

hink Global, Make Symp' All !
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!